Analyst/A128XGA.1023.txt

* LST OFF
 SBTL
 X6502
 MSB ON
 ORG $7000 
 SKP 1 
*********************************
*                               *
*       -< THE ANALYST >-       *
*                               *
*        128K VERSION XG        *
*                               *
*      BUILD 1023 01/19/19      *
*                               *
*   (UPDATE BUILD# IN TITLE)    *
*                               *
*********************************
 SKP 1 
*** COMMANDS ***
 SKP 1 
; CTRL-F   FIND HEX SEQUENCE DEFINED BY F(H)
;      G   GO EXECUTE IN IMMEDIATE MODE  
;      H   LOAD BYTES FOR HSF F(CTRL-F) BY USING H: 
;      I   DISPLAY/SET PC/INTERNAL A,X,Y,P,S REGISTERS
;      J   JUMP. EXECUTE JSR INSTRUCTION IN STEP MODE
; CTRL-L   CLEAR PRESENT SCREEN AND HOME CURSOR
;      L   LIST DISASSEMBLY OR LOOP IN TRACE MODE.
;      M   MOVE BLOCK OF MEMORY
;      P   SEND OUTPUT TO PRINTER
;      R   RELOCATE ANALYST TO NEW ADDRESS PAGE
;      S   ENTER STEP MODE. STEP INSTRUCTION
;      T   TRACE PROGRAM
;      V   PRINT ANALYST VERSION# AND ORIGIN ADDRESS.
; CTRL-X   MOVE ANALYST TO AUX. DISABLED AFTER USE.
;      X   SKIP INSTRUCTION DURING STEP. TOGGLE MAIN/AUX
;      "   DUMP MEMORY IN ASCII 
;      /   SET OR PRINT SUBROUTINE TO JSR IMMED MODE
;      &   EXIT TO OR FROM DOS / PRODOS
;      ?   PRINT LAST 16 PC'S EXEC'D DURING TRACE
;      @   SET TEXT 40/80 COL SCREEN
;      <   RANGE DELIMITER
;      .   RANGE DELIMITER
;      :   STORE VALUE IN MEMORY
 SKP 1
*** ROM ZERO PAGE EQUATES *** 
 SKP 1
MCSWL EQU $36
MCSWH EQU $37
MA1 EQU $3C
MA2 EQU $3E
MA4 EQU $42
CURLIN EQU $75 #1021 APPLESOFT CURRENT LINE NUMBER
 SKP 1
*** ANALYST EQUATES ***
 SKP 1
PCL EQU $EF LABEL MARKS PAGE 0 
PCH EQU $F0
BASL EQU $F1
BASH EQU $F2 LABEL USED AS IDENTIFIER
ZFLG EQU $F3 1 BYTE ID = $AA
A1L EQU $F4 A1L-A5H MUST BE IN ORDER
A1H EQU $F5 FOR MINI-ASSEMBLER 
A2L EQU $F6 
A2H EQU $F7 
A3L EQU $F8 
A3H EQU $F9 
A4L EQU $FA 
A4H EQU $FB 
A5L EQU $FC 
A5H EQU $FD 
BAS2L EQU $FE
BAS2H EQU $FF LABEL MARKS END OF PAGE 0
IN EQU $0132 #1019
WARMV EQU $0162 WARM REENTRY #1019 MOVED UP $30
XQTS EQU WARMV+6 EXEC AREA FOR STEP, TRACE
YPOKE EQU XQTS+21
PEEK EQU XQTS+29
YPEEK EQU XQTS+31
XQT EQU XQTS+50 18 BYTES
PCBUF EQU XQT+18 32 BYTE PC SAVE AREA.
*IN EQU PCBUF+32 KEYIN BUFFER. 38 BYTES.
MLI EQU $BF00 PRODOS INTERFACE
 SKP 1
*** ROM EQUATES ***
 SKP 1
ENAPAGE2 EQU $C000 ENABLES AUX FOR GRAPHICS PAGE 2
KBD EQU $C000
INHPAGE2 EQU $C001 AUX $400-7FF SHOWS TEXT
MAINRD EQU $C002
MAINWR EQU $C004
CLR80VID EQU $C00C
SET80VID EQU $C00D
KBDSTRB EQU $C010
RDAUXZP EQU $C016 BMI IF AUXZP
RDPAGE2 EQU $C018 BMI IF INHPAGE2 ON
RDTEXT EQU $C01A BMI IF TEXT MODE
RDSCR EQU $C01C BMI IF DPAGE2 ON
RD80VID EQU $C01F BMI IF 80 COL MODE
SPKR EQU $C030
TXTCLR EQU $C050
TXTSET EQU $C051
MIXCLR EQU $C052
LOWSCR EQU $C054
HISCR EQU $C055
HIRES EQU $C057
PB0 EQU $C061 OPEN APPLE KEY
PB1 EQU $C062 CLOSED APPLE KEY
SWITCH2 EQU $C082
PR1 EQU $C100 #1019 INIT PRINTER IN SLOT 1
AUXMOVE EQU $C311
NEWSTT EQU $D7D2 #1022 APPLESOFT NEXT STATEMENT
MWAIT EQU $FCA8 #1023 ROM WAIT ALWAYS HANDLED IMMEDIATE
MVIDOUT EQU $FDF0
OUTPORT EQU $FE95 USED TO SET PRINTER
IDROM EQU $E000 = $4C IF ROM PRESENT
 SKP 3 
START SED  TEST FOR 65C02 IN DECIMAL MODE
 LDA #$99
 CLC
 ADC #$01 ROLLING ACC FROM 99 TO 100 IN DECIMAL
 CLD  AFFECTS N FLAG DIFFERENTLY
 BPL X65C02 BETWEEN A 6502 VS A 65C02
 LDX #$F3 6502 SETS N FLAG AND GETS HERE
REQU LDA NOT65C-$F3,X #1013 INCREASED X INDEX BY 5
 JSR MVIDOUT USE THIS TO AVOID DOS HOOKS
 INX
 BNE REQU
 RTS
X65C02 JMP RESET COLD START
INSDS1 LDX PCL
 LDY PCH
 JSR CROUT
 JSR PRYX2
 JSR OUTSP
INSDST LDA PCH
 CMP #<WARMV IS PC IN STACK REGION BELOW WARMV ?
 BNE INSDSP
 LDA PCL
 CMP #>WARMV
 BCS INSDSP
 LDY #>WARMV-1 IT IS SO COPY REGION FROM PSEUDO-STACK
COPYSTK LDA STACK,Y
 STA $100,Y
 DEY
 BPL COPYSTK
INSDSP JSR PEEK
 LDY #$FF DETERMINE LENGTH OF
 STY LMNEM INSTRUCTION. OPCODE IN
 TAY  ACC. STORED IN LENGTH.
 LSR A INVALID =  0
 BCC IEVEN 1 BYTE = 0
 ROR A 2 BYTE = 1
 BCS ERR 3 BYTE = 2
 AND #$87
IEVEN LSR A
 TAX 
 LDA FMT1,X
 BCC RTMSKZ
 LSR A
 LSR A
 LSR A
 LSR A
RTMSKZ AND #$0F
 CMP #$0F
 BNE GETFMT
ERR LDY #$FF BAD OPCODE
 STY ERRFLG
 INY
 STY LMNEM
 STY RMNEM
 STY FORMAT
 STY LENGTH
RTS1 RTS
GETFMT TAX 
 LDA FMT2,X
 STA FORMAT
 AND #$03
 STA LENGTH
 LDA TFLG BYPASS PRINT FORMATTING
 BNE RTS1 IN TRACE
 TYA 
 AND #$8F
 PHA  TEMP STORAGE
 TYA 
 LDX #31
GETFMT2 DEX
 BMI MNNDX
 CMP OPC65C,X MAKE SUBSTITUTION IF
 BNE GETFMT2 65C02 OPCODE.
 LDA REPL65C,X
MNNDX PLX
 LDY #$03
 CPX #$8A
 BEQ MNNDX3
MNNDX1 LSR A
 BCC MNNDX3
 LSR A
MNNDX2 LSR A
 ORA #$20
 DEY 
 BNE MNNDX2
 INY 
MNNDX3 DEY 
 BNE MNNDX1
 RTS 
INSTDSP JSR INSDS1
 PHA 
PRNTOP JSR YPEEK
 JSR PRBYTE
 LDX #$01
PRNTBL JSR PRBLNK
 CPY LENGTH
 INY 
 BCC PRNTOP
 LDX #$03
 CPY #$03
 BCC PRNTBL
 PLA 
 TAY 
 LDA LMNEM
 BEQ PRMN1
 LDA MNEML,Y
 STA LMNEM
 LDA MNEMR,Y
 STA RMNEM
PRMN1 LDA #$00
 LDY #$05
PRMN2 ASL RMNEM
 ROL LMNEM
 ROL A
 DEY 
 BNE PRMN2
 ADC #$BF
 JSR COUT
 DEX 
 BNE PRMN1
 JSR OUTSP
 LDY LENGTH
 LDX #$05
PRADR1 CPX #$02
 BEQ PRADR5
PRADR2 ASL FORMAT
 BCC PRADR3
CHAR1LOC LDA CHAR1,X #1020
 JSR COUT
 LDA CHAR2,X
 BEQ PRADR3
 JSR COUT
PRADR3 DEX 
 BPL PRADR1
 RTS 
PRADR4 DEY 
 BMI PRADR2
 JSR PRBYTE
PRADR5 LDA FORMAT
 CMP #$E8
 JSR YPEEK
 BCC PRADR4
 JSR PCADJA
 TAX 
 INX 
 BNE PRNTYX
 INY 
PRNTYX TYA 
PRNTAX JSR PRBYTE 
 TXA 
 JMP PRBYTE
PRBLNK3 LDX #3
PRBLNK JSR OUTSP PRINT X SPACES
 DEX 
 BNE PRBLNK
 RTS 
PCADJ SEC  UPDATE PC BY LENGTH+1 
PCADJLP LDA LENGTH UPDATE PC BY LENGTH
PCADJAP JSR PCADJA UPDATE PC BY ACC
 STA PCL
 STY PCH
 RTS
PCADJL LDA LENGTH SET Y,A = PC+LENGTH 
PCADJA LDY PCH SET Y,A = PC+ACC 
 TAX 
 BPL PCADJ2
 DEY 
PCADJ2 ADC PCL
 BCC RTS2
 INY 
RTS2 RTS 
STEP DEC YSAV F(S)
STEPL TXA
 BEQ STEPZ
 JSR SETBREAK FIRST TIME
 LDX #1
 BNE SSTEP ALWAYS TAKEN
STEPZ JSR KYWAIT
 BNE STEP1
 INC YSAV CTRL-C = EXIT TO NEXTITM
 JMP ZSWAPE VIA ZSWAPE RTS
STEP1 CPY #$CA
 BNE STEP2 
 LDA JFLG J = SINGLE STEP
 BEQ SSTEP IF NO JSR, ELSE
 JMP TRCPCS EXECUTE SUBROUTINE
STEP2 CPY #$CC L = LOOP. SET BREAK
 BNE STEP2A POINT AFTER INSTRUCTION
 JSR PCADJL TO BE EXECUTED NEXT
 STA BRKADDR AND ENTER TRACE.
 STY BRKADDR+1 
 BRA STEPT
STEP2A LDA JFLG SPC = SINGLE STEP IF
 BNE STEP3 NOT JSR, ELSE IGNORE
 CPY #$A0 
 BEQ SSTEP
STEP3 CPY #$D3 S OR OPEN APPLE =
 BEQ SSTEP SINGLE STEP ALWAYS
 TYA
 BEQ SSTEPW = 0 FOR OPEN APPLE.
 CPY #$D4 T = ENTER TRACE MODE
 BNE STEP4
 LDY #$FF
STEPT STY TFLG SET TRACE MODE FLAG
 STY PCFLG ENABLE PC PRINTING
 JMP STRACE AND ENTER TRACE.
STEP4 CPY #$D8 X = SKIP NEXT INSTRUCTION
 BNE STEP5
 STZ JFLG ENABLE SPC IF SKP WHILE
 STZ ERRFLG JSR DISPLAYED ACTIVE.
 JSR PCADJ CLR IN CASE SKIP ERROR.
 JMP JRTSX
STEP5 CPY #$C0 @ = TEXT MODE
 BNE STEPL LOOP BACK FOR INPUT
 JSR TEXT
SSTEPW JSR FWAIT PAUSE TO RELEASE O/A KEY
SSTEP JSR A1PC
SSTEPT JSR CLEARDSP TRACE RE-ENTRY TO STEP
 JSR INSTDSP
 JSR PRBLNK3
 JSR PEEK
 AND #$0F
 CMP #$01 SEE IF ZERO PAGE IND
 BNE SSTEPZ
 LDA #$A8 '('
 JSR COUT PRINT ABSOLUTE VALUE
 JSR PEEK IN PARENTHESIS
 AND #$10
 BNE INDY TAKEN FOR (NN),Y.
 LDX XREG FOR (NN,X).
INDY TXA  X=0 FOR (NN),Y
 STA TEMP1
 LDY #1
 JSR YPEEK
 CLC
 ADC TEMP1
* PHA #1021 PROGRAM PAGE 0 ALREADY PRESENT
* JSR ZSWAP GET PROGRAM PAGE 0 AND
* PLA  SAVE POINTER ADDRESS ON STACK
 TAX
 LDA $01,X
 PHA
 LDA $00,X
* PHA #1021 PROGRAM PAGE 0 ALREADY PRESENT
* JSR ZSWAP RESTORE ANALYST PAGE 0
* PLA  AND RECOVER POINTER ADDR.
 TAX
 PLA
 JSR PRNTAX
 LDA #$A9 ')'
 JSR COUT
SSTEPZ JMP TSTEP 
PRNTPC LDA #$FF PRINT PC AT TOP OF SCREEN
 STA CV BY FORCING CROUT TO INC
 JSR CROUT CV TO 0 (NEED FOR 80 COL)
 LDA ASFLAG #1022 SEE IF NEWSTT EXECUTED
 BEQ NOASFT
 LDX CURLIN #1022 PRINT APPLESOFT LINE# UPPER LEFT
 LDA CURLIN+1
 JSR PRNTAX
NOASFT LDA #29
 STA CH
 LDA PROMPT
 JSR COUT
 LDA PCH
 LDX PCL
 JMP PRNTAX 
TRACEPC LDA PCH #1022 CHECK IF PC=NEWSTT
 CMP #<NEWSTT
 BNE TRCPCA
 LDA PCL
 CMP #>NEWSTT
 BNE TRCPCA
 LDA #1
 STA ASFLAG CURRENTLY RUNNING APPLESOFT
TRCPCA LDX PCPNT SAVE PC TO BE EXEC'D
 LDA PCH IN LIST BUFFER.
 STA PCBUF,X
 INX
 LDA PCL
 STA PCBUF,X
 INX
 CPX #32
 BCC PNTINC
 LDX #0
PNTINC STX PCPNT
 LDA PB0
 BPL TRCPC1
 LDA PCFLG O/A TOGGLES PRINT PC
 EOR #$FF ON/OFF
 STA PCFLG
 JSR FWAIT PAUSE TO RELEASE O/A KEY
TRCPC1 LDA PCFLG
 BEQ TRCPC2 BYPASS PRINTING PC.
* INC COUNTER PRINT PC  
* BNE TRCPC2 EVERY 256 INSTRUCTIONS 
 LDA PROMPT FLASHING '$' FOR TRACE
 EOR #$04 ACTIVITY. $A4->$A0->$A4
 STA PROMPT
 JSR PRNTPC
TRCPC2 LDA JFLG
 BEQ TRACE5
 LDA PCH
 CMP #$C0
 BCC TRCPCD
 CMP #<MWAIT #1023 ALWAYS JSR $FCA8 IMMEDIATE
 BNE NWAIT
 TAY  SAVE PCH
 LDA PCL
 CMP #>MWAIT
 BEQ TRCPCI HANDLE $FCA8 IMMEDIATE
 TYA  RESTORE PCH
NWAIT LDY ROMFLG
 BNE TRCPCD
 CMP #$D0
 BCC TRCPCI
 LDY IDROM JSR ROM $C000-FFFF IN
 CPY #$4C IMMEDIATE MODE UNLESS
 BEQ TRCPCI ROM FLAG SET <> 0.
TRCPCD CMP DOSCALL+1 TRACE THRU JSR UNLESS =
 BNE TRACE5 DOS SUBROUTINE SPECIFIED
 LDA PCL BY F(/).
 CMP DOSCALL
 BNE TRACE5
TRCPCI LDA PCFLG EXEC JSR IMMEDIATE. DON'T
 BEQ TRCPCS PRINT IF O/A TURNED OFF.
 JSR SPROMPT '#' DENOTES JSR IMMED.
 JSR PRNTPC PRINT EXEC SUBROUTINE
 JSR DPROMPT '$' PROMPT
 LDA #$FF FORCE PC PRINTING
 STA COUNTER AFTER JSR IMMED.
TRCPCS LDA PCL SEE IF PC = $BF00
 BNE TRCPCG
 LDA PCH
 CMP #<MLI
 BNE TRCPCG
 LDY #3 3 PARMS FOR PRODOS MLI
 DFB $2C SKIP NEXT INSTRUCTION
TRCPCG LDY #0 0 PARMS FOR EXEC
 JMP GOPC
TRACE JSR A1PC F(T) A4<A1T A4=ENTER STEP
 JSR SETBREAK SET OR CLEAR BREAKPOINT
 STX TFLG SET TRACE FLAG
 STX PCFLG PC PRINTING ON
STRACE STZ PCPNT STEP -> TRACE ENTRY POINT
 STZ DSPTOP FOR STEP -> TRACE
 JSR DPROMPT '$' PROMPT
 JSR CLEARDSP
TRACE5 LDX #1 IF PC = A4 THEN ENTER STEP
TRACE6 LDA PCL,X
 CMP BRKADDR,X
 BEQ TRACEL
 JMP TRACE7
TRACEL DEX
 BPL TRACE6
 JSR SETBREAK CLEAR OLD BREAKPOINT
TRACES STA KBDSTRB
 STZ TFLG CLEAR TRACE FLAG
 STZ DSPTOP RESET DISPLAY TO TOP
 JSR STPRMPT PROMPT BACK TO OLD '#'
 DEC YSAV
 LDY YSAV
 LDA #$D3 PUT 'S' INTO INPUT BUFFER
 STA IN,Y
 JMP SSTEPT RE-ENTER STEP MODE
NBRNCH JSR SAVE ALL OTHER OPCODES 
 BRA UPDPC
BRANCH JSR SAVE BRANCH WITH COND. MET 
 CLC 
 LDY #$01
 JSR YPEEK
 JSR PCADJAP
UPDPC SEC
PCINC JSR PCADJLP
NEWPC LDA TFLG
 BNE TRACEBY BYPASSES NEXTITM
NXTPC JSR CROUT 
 JMP REGDSP
TRACEBY JMP TRACEPC
XJMPATX INX
 BNE XJMPAT
XJSR STA JFLG OK FOR F(J) 
 INC DSPTOP
 CLC
 JSR PCADJL SET Y,A = RTS ADDR 
 PHA
 LDX SPNT
 TYA 
 STA STACK,X
 DEX 
 PLA 
 STA STACK,X
 DEX
 STX SPNT
 LDY #$02
XJMP CLC 
XJMPAT JSR YPEEK
 PHA 
 DEY 
 JSR YPEEK
 STA PCL
 PLA
 STA PCH
 BCC NEWPC
 DEX
 BNE XJMP
 LDA XREG
 CLC
 JSR PCADJAP
 LDY #1
 BRA XJMP
TRACE7 LDA PB1 BACK TO STEP MODE IF
 BMI TRACES CLOSED APPLE PRESSED
 JSR INSDST
TSTEP LDA ERRFLG IF BAD OPCODE THEN BRK 
 BNE XBRK
 STZ JFLG DISALLOW F(J) IF NO JSR 
 JSR PEEK GET OPCODE
 LDY LENGTH
 CPY #2 CHECK ALL 3-BYTE INST
 BEQ TSTEP3
 JMP TSTEP4
TSTEP3 CMP #$20
 BEQ XJSR
 CMP #$7C
 BEQ XJMPATX
 CMP #$4C
 BEQ XJMP
 CMP #$6C
 BEQ XJMPAT
*
* #1015 HANDLE $00FF AND $01FF INDEXED SPECIAL BECAUSE OF APPLESOFT ROM
*
 PHA  SAVE OPCODE.
 JSR YPEEK GET OPERAND ADDRESS HIGH
 CMP #$02
 BCS TSTEP3X TAKEN IF PC >= $200 
 TAX  SAVE OPERAND ADDRESS HIGH
 PLA  OPCODE
 PHA  CHK FOR INDEXED OPERAND ADDR PAGE 0 OR 1
 CMP #$99 STA NNNN,Y
 BEQ INDX
 CMP #$9D STA NNNN,X
 BEQ INDX
 CMP #$B9 LDA NNNN,Y
 BEQ INDX
 CMP #$BD LDA NNNN,X
 BEQ INDX
 TXA  OPERAND ADDRESS HIGH
 BEQ TSTEP3RS TAKEN FOR ABSOLUTE $00NN
 JSR YPEEK1 #1016 NOW ABSOLUTE $01NN. GET OPERAND LOW
 CMP #$FE CHECK $1FE-1FF AND HANDLE ABSOLUTE
 BCS TSTEP3RS REAL STACK FOR APPLESOFT ROM LINE#
NIDXS PLA  ADJ STACK. NOW < $01FE ABSOLUTE
 LDA STACKLOC+2 SUBSTITUTE PSUEDO-STACK
 BRA XQSTK
INDX JSR YPEEK1 NOW 00NN OR 01NN INDEXED. GET OPERAND LOW
 CMP #$FB = 00FN OR 01FN INDEXED ?
 BCS IDXFN
 TXA
 BNE NIDXS HANDLE $01NN INDEXED (NOT FN) PSEUDO STACK
 BEQ TSTEP3RS FOR $00NN INDEXED (NOT FN)
IDXFN TXA  OPERAND ADDR HIGH
 BNE TSTEP3RS $01FN INDEXED WILL BE IN $200 KEYIN BUFFER
 PLA  ADJ STACK. HANDLE $00FN INDEXED
 LDX STACKLOC+2 SUBSTITUTE PSEUDO-STACK -1
 DEX  FOR 00FN INDEXED INTO STACK
 TXA
 BRA XQSTK
XQST1 JSR YPEEK
XQSTK STA XQTS+3,Y
 DEY
 BPL XQST1
XQRST JSR RESTORE #1018
 JMP XQTS+3 EXEC IN ANALYST R/W MODE
XBRK STZ DSPTOP
 STZ TFLG
 JSR CLEARDSP
 JSR INSTDSP
 JSR CROUT
 JSR RGDSP1
 JSR BELL
 JMP ZSWAPE EXIT VIA NEXTITM
TSTEP3RS JSR YPEEK RESTORE OPERAND ADDR HI BYTE
TSTEP3X CMP #$C0 $C002-C005, $C008-C009
 BNE TSTEP5N AUX R/W SWITCHES HANDLE SPECIAL
 JSR YPEEK1 GET OPERAND ADDR LOW
 CMP #$02
 BCC TSTEP5C
 CMP #$04
 BCC TSTEPRD
 CMP #$06
 BCC TSTEPWR
 CMP #$08
TSTEP5C BCC TSTEP5
 CMP #$0A
 BCS TSTEP5
 STA TEMP3
 ROR A
 ROR A
 EOR RDAUXZP
 BPL STOUT2 NO CHANGE IN ZP STATE.
 JSR ZSWAP RESTORE PROGRAM ZP.
 LDA TEMP3 NEW ZP STATE
 LSR A ODD/EVEN 9/8
 BCS ODDNEW
 LDA #9 NEW = 8
 DFB $2C
ODDNEW LDA #8 NEW = 9
 STA TEMP2 OLD STATE
 LDX #0 COPY XQTS ACROSS
STKLOOP LDY TEMP2
 STA $C000,Y OLD ZP
 LDA $0100,X
 LDY TEMP3
 STA $C000,Y NEW ZP
 STA $0100,X
 INX
 BEQ STKOUT
 CPX #>IN+12
 BNE STKLOOP
 TSX  COPY ANALYST STACK ACROSS
 BRA STKLOOP
TSTEPRD STA XQTS+44 SET PROGRAM READ STATE.
 BRA STOUT2
TSTEPWR STA XQTS+47 SET PROGRAM WRITE STATE.
 BRA STOUT2
STKOUT JSR ZSWAP PUT ANALYST ZP BACK.
STOUT2 PLA  PULL OPC TO ADJ STACK
UPDPCGO JMP UPDPC
TSTEP4 CPY #1
 BNE LEN0 TAKEN FOR 1 BYTE INSTRUCTION
 PHA  SAVE OPCODE OF 2 BYTE INSTRUCTION
 CMP #$B1 #1018 TEST IF (ZP),Y IS IN STACK PAGE
 BEQ TSTEP4I IF LDA (ZP),Y
 CMP #$91 STA (ZP),Y ?
 BNE TSTEP5N
TSTEP4I JSR YPEEK GET ZP OPERAND FOR LDA/STA (ZP),Y
 TAX  NOW X = OFFSET IN PAGE 0 TO INDEXED ADDR
 LDA $01,X GET ADDR HIGH WHERE OPERAND POINTS
 CMP #$01 IS (ZP) POINTING TO STACK PAGE?
TSTEP5N BNE TSTEP5
 LDA STACKLOC+2 SUBSTITUTE PSEUDO-STACK
 STA XQTS+5 CHANGE LDA/STA (ZP),Y TO LDA/STA $01NN,Y
 LDA $00,X PCL
 STA XQTS+4
 PLA  OPCODE
 ORA #$08 CHANGE TO ABS INDEXED,Y
 STA XQTS+3 NEW OPCODE
 JMP XQRST EXECUTE (ZP),Y AS $01NN,Y ABSOLUTE
TSTEP5 LDA #$EA 
 STA XQTS+4
 STA XQTS+5
 PLA  OPCODE
 CMP #$80
 BNE NBRA
 ORA #$10
NBRA AND #$1F
 EOR #$14
 CMP #$04 = BRANCH OFFSET 
 BEQ XQ2 TAKEN IF BRANCH OPCODE 
XQ1 JSR YPEEK Y = LENGTH
XQ2 STA XQTS+3,Y XQT   BCS BRNCH (B0 04)
 DEY        NOP 
 BPL XQ1       JMP NBRNCH (CCLR)
 JSR RESTORE BRNCH JMP BRANCH (CSET)
 JMP XQTS
XTSX LDX SPNT
 STX XREG
XTXS LDX XREG
 STX SREF
UPDSPNT STX SPNT UPDATE SPNT
 BRA UPDPCGO
LEN0 CMP #$60
 BEQ XRTS
 CMP #$BA
 BEQ XTSX
 CMP #$9A
 BEQ XTXS
 CMP #$40
 BEQ XRTIGO HANDLE RTI INSTRUCTION #1019
 CMP #$00
 BNE PHCHECK
 JMP XBRK
XRTIGO JMP XRTI
PHCHECK PHA  SAVE OPCODE
 CMP #$5A
 BCC TSTEP6
 TAX
 AND #$1F
 CMP #$1A
 BEQ STKOPC PHX,PLX,PHY,PLY
 TXA
TSTEP6 AND #$9F
 CMP #$08 PHA,PLA,PHP,PLP
 BNE TSTEP5
STKOPC LDX SPNT STACK OPCODES
 PLA  OPCODE
 TAY
 AND #$10
 BEQ APCODE
 TYA
 ASL A
 BCS OPCX
 ASL A
 ASL A
 BCS XPLY
 LDA YREG XPHY
 BRA PUSH
XPLY JSR PULL
 STA YREG
UPDSTACK BRA UPDSPNT
OPCX ASL A
 ASL A
 BCS XPLX
 LDA XREG XPHX
 BRA PUSH
XPLX JSR PULL
 STA XREG
 BRA UPDSTACK
APCODE TYA
 ASL A
 ASL A
 BMI PULLAP
 BCC XPHP
 LDA ACC XPHA
 BRA PUSH
XPHP LDA STATUS
PUSH STA STACK,X
 DEX
 BNE UPDSTACK
PULLAP BCC XPLP
 JSR PULL XPLA
ACCLOC STA ACC
 BRA UPDSTACK
XPLP JSR PULL
 STA STATUS
 BRA UPDSTACK
XRTS LDX SPNT
 INX
STACKLOC LDA STACK,X
 STA PCL
 INX
 LDA STACK,X
 STA PCH
 STX SPNT
 DEC DSPTOP
 JMP PCINC
XRTI LDX SPNT  HANDLE RTI #1019
 INX
 LDA STACK,X
 STA STATUS
 INX
 LDA STACK,X
 STA PCL
 INX
 LDA STACK,X
 STA PCH
 STX SPNT
 JMP NEWPC
PULL INX
 LDY STATUS PULL FROM STACK AFFECTS
 PHY  N & Z FLAGS
 PLP
 LDA STACK,X
 PHP  UPDATE N & Z
 PLY
 STY STATUS
 RTS
YPOKEPC PHA  EXECUTE STA (PCL),Y
 LDA PCL
 STA A3L
 LDA PCH
 STA A3H
 PLA
 JMP YPOKE
*
* XQTS IMAGE AT $122-159. INSTRUCTIONS WITH '@' ARE
* CHANGEABLE IN XQTS AREA TO SET MAIN/AUX R/W STATE.
*
INITBL JSR XQTS+36 WARMV. REAL-TIME REENTRY
 JMP REENTER BY JSR $102.
 JSR XQTS+43 XQTS
 NOP
 NOP
 NOP
 JMP XQTS+15
 JSR XQTS+36
 JMP BRANCH
 JSR XQTS+36 XQTS+15
 JMP NBRNCH
 JSR XQTS+43 YPOKE
 STA (A3L),Y
 JMP XQTS+36
 LDY #0 PEEK
 JSR XQTS+43 YPEEK
 LDA (PCL),Y
 STA MAINRD @ XQTS+36. SET ANALYST
 STA MAINWR @ STATE
 RTS
 STA MAINRD @ XQTS+43. SET PROGRAM
 STA MAINWR @ STATE
 RTS
*
YPEEK1 DEY  GET YPEEK-1 #1017
 JSR YPEEK
 INY
 RTS
SETBREAK LDX #1 SET BREAKPOINT TO A4
 LDA BRKADDR+1 IF GIVEN, ELSE $FFFF.
 BEQ SETBRK2 BREAKPOINT GIVEN
 LDA #$FF
SETBRK1 STA BRKADDR,X CLEAR OLD BREAKPOINT
 DEX
 BPL SETBRK1
 RTS
SETBRK2 LDA A4L,X SET BREAKPOINT
 STA BRKADDR,X
 DEX
 BPL SETBRK2
 RTS
LOAD LDA XQLOC1+1 F(H)
 LDY XQLOC1+2 SETUP A3 = XQT+1 FOR HSF
 BRA A3SET BUFFER (XQT=BYTE COUNT)
SETRG1 JSR A1PC
 JSR SAVEPC
SETRG2 LDA ACCLOC+1 SETUP REGS FOR F(:)
 LDY ACCLOC+2
A3SET STA A3L
 STY A3H
 RTS
SETREG TXA  F(I) SET OR DISPLAY REGS.
 BNE SETRG1 TAKEN IF PC GIVEN.
 LDY YSAV
 LDA IN,Y
 CMP #$8D
 BNE SETRG2
 LDA PCREG I <CR> DISPLAYS REGS.
 STA PCL
 LDA PCREG+1
 STA PCH
REGDSP JSR RGDSP1
 JMP INSTDSP WILL RTS TO NEXTITM
RGDSP1 LDX #0 
RDSP1 LDA RTBL,X 
 JSR COUT
 LDA #$BD
 JSR COUT
 LDA ACC,X 
 JSR PRBYTE
 JSR OUTSP
 INX 
 CPX #3
 BCC RDSP1
 LDX #7
PRFLG LDA CHAR3,X PRINT 'NV-BDIZC' 
 JSR COUT
 DEX 
 BPL PRFLG
 JSR CROUT 
 LDA #$C1 PRINT ACC IN BINARY
 JSR COUT 
 JSR OUTEQ
 LDA ACC
 JSR BNDSP
 JSR PRBLNK3
 LDA #$D0 PRINT STATUS IN BINARY
 JSR COUT
 JSR OUTEQ
 LDA STATUS
 JSR BNDSP
 JSR CROUT
 LDA #$D3
 JSR COUT
 JSR OUTEQ
 LDA SPNT
 JSR PRBYTE
 LDA #$BA
 JSR COUT
 LDA #$D8
 JSR COUT
 JSR COUT
 LDY #8
 LDX SPNT
PRNTSTK JSR OUTSP PRINT STACK BYTES FROM
 CPX SREF SPNT TO SREF UP TO 6
 BEQ SAVEPC MAX.
 INX
 LDA STACK,X
 JSR PRBYTE
 DEY
 BNE PRNTSTK
SAVEPC LDA PCL
 STA PCREG
 LDA PCH
 STA PCREG+1
 RTS
BNDSP LDX #$08 INDEX FOR 8 BITS 
NEXTBIT ASL A
 PHA 
 BCS BIT1
 LDA #$B0 '0' 
 DFB $2C SKIP NEXT INSTRUCTION
BIT1 LDA #$B1 '1' 
 JSR COUT
 PLA 
 DEX 
 BNE NEXTBIT 
 RTS 
BELL LDY #$38 DURATION 
BELL2 LDA #$2B FREQUENCY 
 JSR WAIT
 LDA SPKR
 DEY
 BNE BELL2
 RTS
COUTZ JMP (CSWL)
VIDOUT BIT #$60
 BEQ CTRLCHAR
 TAY 
 CMP #$60
 BCS VID1
 CMP #$40
 BCC VID1
 AND #$BF
VID1 LDY CH
 BIT RD80VID
 BPL VID3
 PHA
 TYA
 LSR A
 BCS VID2
 STA HISCR
VID2 TAY
 PLA
VID3 STA (BASL),Y
 STA LOWSCR
 LDY CH
 INY
 CPY WNDWDTH
 BCS CR
 STY CH
VIDRTS RTS
BACKSPC DEC CH
 BPL VIDRTS
 LDY WNDWDTH
 DEY 
 STY CH
 LDA CV
 DEC A
 CMP #0
 BMI VIDRTS
VTABVGO JMP VTABV
CTRLCHAR ORA #$80
 CMP #$88
 BEQ BACKSPC
 CMP #$8D
 BNE VIDRTS
CR LDA #$00
 STA CH
 INC CV
 LDA CV
 CMP #24
 BCC VTABVGO
 DEC CV
 LDX #0 SCROLL
 TXA 
 JSR VTABZ
 BRA SCRL5
SCRL1 LDY BASH
 STY BAS2H
 LDY BASL
 STY BAS2L
 TXA 
 JSR VTABZ
 PHX 
 LDX WNDWDTH
 LDY #0
SCRL2 BIT RD80VID
 BPL SCRL3
 STA HISCR
 LDA (BASL),Y
 STA (BAS2L),Y
 DEX 
 BEQ SCRL4
 STA LOWSCR
SCRL3 LDA (BASL),Y
 STA (BAS2L),Y
 INY 
 DEX 
 BNE SCRL2
SCRL4 STA LOWSCR
 PLX 
SCRL5 INX 
 CPX #24
 BCC SCRL1
 LDA #$00
 JSR CLEOLZ
 JMP VTAB
HOME LDA #0
 STA CH
 STA CV
 BIT RDTEXT
 BMI CLS1
 RTS  DO NOT CLEAR TEXT PAGE IF IN GRAPHICS MODE
CLS1 PHA 
 JSR VTABZ
 LDA #0
 JSR CLEOLZ
 PLA 
 INC A
 CMP #24
 BCC CLS1
VTAB LDA CV
VTABV STA CV
VTABZ PHA 
 LSR A
 AND #$03
 ORA #$04
 STA BASH
 PLA
 AND #$18
 BCC BSCLC2
 ADC #$7F
BSCLC2 STA BASL
 ASL A
 ASL A
 ORA BASL
 STA BASL
 RTS 
CLREOL LDA CH
CLEOLZ BIT RD80VID
 BPL CLEOL4
 PHA  CLREOL 80 COL
 SEC 
 SBC WNDWDTH
 TAX 
 PLA 
 LSR A
 TAY 
 PHP 
 LDA #$A0
 PLP 
 BCS CLEOL8B
CLEOL8A STA HISCR
 STA (BASL),Y
 INX 
 BEQ CLEOL8C
CLEOL8B STA LOWSCR
 STA (BASL),Y
 INY 
 INX 
 BNE CLEOL8A
CLEOL8C STA LOWSCR
 RTS 
CLEOL4 TAY 
 SEC 
 SBC WNDWDTH
 TAX 
 LDA #$A0
CLEOL4A STA (BASL),Y
 INY 
 INX 
 BNE CLEOL4A
 RTS 
CLEARDSP LDX #6 CLEAR DISPLAY WINDOW
CLRDSP1 LDA DSPTOP
 BPL CLRDSP2 HOLD TOP OF DISPLAY
 LDA #0 0 <= TOP <= 18.
CLRDSP2 CMP #18
 BCC CLRDSP3
 LDA #18
CLRDSP3 STA DSPTOP
 STA CV CLEAR 6 LINE DISPLAY
 DEC CV FROM DSPTOP DOWN AND
 TXA  SET CV SO INSTDSP WILL
 BEQ RTS4A PRINT AT DSPTOP UPON
CLRDSP4 JSR CROUT EXIT.
 PHX
 BIT RDTEXT IF IN TEXT MODE, DO NORMAL CLREOL
 BMI CLRDSPT BECAUSE WRITES TO TEXT SCREEN
 LDX #34
 JSR PRBLNK
 BRA CLRDSPG
CLRDSPT JSR CLREOL
CLRDSPG PLX
 DEX
 BNE CLRDSP4
 BEQ CLRDSP1
RTS4A RTS
FWAIT LDA #$FF
WAIT SEC 
WAIT2 PHA 
WAIT3 SBC #$01
 BNE WAIT3
 PLA 
 SBC #$01
 BNE WAIT2
 RTS 
NXTA4 INC A4L INCREMENT A4 
 BNE NXTA1
 INC A4H
NXTA1 LDA A1L
 CMP A2L
 LDA A1H
 SBC A2H
 INC A1L
 BNE RTS4B
 INC A1H
RTS4B RTS  CARRY SET IF A1 >= A2 
CTRLC LDY KBD CHECK FOR CTRL-C 
 BPL CTLCRTS
 STY KBDSTRB
 CPY #$93 CTRL-S = PAUSE 
 BNE CTLC
KYWAIT LDY PB0 F(S) ENTRY POINT
 BMI KYWT2
 LDY KBD
 BPL KYWAIT
 STY KBDSTRB
 DFB $2C
KYWT2 LDY #0 0 = OPEN APPLE PRESSED
CTLC CPY #$83
CTLCRTS RTS  Z SET FOR CTRL-C.
RDKEY STY YSAV1
 LDY RDSCR
 PHP
 LDY RDPAGE2
 PHP
 BPL KEY1 AVOID FLICKER IF HGR2
 STA LOWSCR
KEY1 PHX
 LDA CH
 BIT RD80VID
 BPL KEY2
 LSR A
 BCS KEY2
 STA HISCR
KEY2 TAY 
 LDA (BASL),Y
 PHA 
 EOR #$80
 BIT #$20
 BNE KEY3
 EOR #$40
KEY3 STA (BASL),Y
KEY4 LDX KBD
 BPL KEY4
 STA KBDSTRB
 PLA 
 STA (BASL),Y
 STA LOWSCR
 TXA 
 JMP ENDHOOK
NOTCR LDA IN,X
 JSR COUT 
 CMP #$88
 BEQ BCKSPC
 CPX #34 BEEP ON LAST 4 CHAR. 
 BCC NOTCR1
 JSR BELL
NOTCR1 INX 
 CPX #38 38 CHARACTERS ALLOWED 
 BCC NXTCHAR 
 LDA #$DC
 JSR COUT 
GETLNZ JSR CROUT
 LDA PROMPT
 JSR COUT 
 LDX #$01
BCKSPC TXA 
 BEQ GETLNZ
 DEX 
NXTCHAR JSR RDKEY
 CMP #$95 
 BEQ NXTCHAR IGNORE '->'
 CMP #$FF
 BNE NOTDEL
 LDA #$88 DELETE KEY = BACKSPACE
NOTDEL CMP #$88
 BNE CAPTST
 PHA
 JSR COUT BACKSPACE
 JSR OUTSP DELETE CHARACTER
 PLA  BACKSPACE
CAPTST CMP #$E0
 BCC ADDINP
 AND #$DF
ADDINP STA IN,X
 CMP #$8D
 BNE NOTCR
CROUT LDA #$8D
 BNE COUTGO
OUTSP LDA #$A0
 BNE COUTGO
PRA1 JSR CROUT
 LDY A1H
 LDX A1L
PRYX2 JSR PRNTYX
 LDY #$00
 LDA #$AD
COUTGO JSR COUT
PRA1RTS RTS
ASC SEC  F(")
XAM ROR A CARRY INTO BIT 7
 STA A3H
 BRA XAM1
MOD8CHK LDA A1L
 AND #$07
 BNE DATAOUT
XAM1 JSR CTRLC F(.) A1.A2 HEX OR ASC
 BEQ PRA1RTS
 JSR PRA1
DATAOUT JSR OUTSP 
 LDA A1H SEE IF ZERO PAGE
 BEQ XAMZ
 DEC A SEE IF $01NN
 BNE XAM2
 LDA A1L GET $01NN FROM STACK,NN
 TAX
 LDA STACK,X
 BRA XAM3
XAMZ LDA A1L
 SEC
 SBC #PCL
 BCC XAM2 TAKEN IF A1L < PCL
 TAX  ELSE GET FROM ZBUF
 LDA ZBUF,X
 BRA XAM3
XAM2 JSR A1PCX
 JSR PEEK
XAM3 LDX A3H
 BPL XAM4 
 ORA #$80 XAM IN ASC
 CMP #$A0
 BCS PRASC TAKEN IF NORM. OR LCASE
 LDA #$A0 SPACE FOR CTRL OR INV   
PRASC JSR COUT
 BRA XAM5
XAM4 JSR PRBYTE XAM IN HEX
XAM5 JSR NXTA1
 BCC MOD8CHK CARRY CLEAR IF A1<A2 
 RTS 
PRBYTE PHA 
 LSR A
 LSR A
 LSR A
 LSR A
 JSR PRHEXZ
 PLA 
 AND #$0F
PRHEXZ ORA #$B0
 CMP #$BA
 BCC COUT
 ADC #$06
COUT STY YSAV1
 LDY RDSCR
 PHP
 LDY RDPAGE2
 PHP
 BPL COUT1 AVOID FLICKER IF HGR2
 STA LOWSCR
COUT1 PHX
 PHA
 JSR COUTZ
 PLA
ENDHOOK PLX  RDKEY EXITS HERE
 LDY YSAV1
 PLP
 BMI COUT2
 STA KBD
 BPL COUT3
COUT2 STA INHPAGE2
COUT3 PLP
 BMI COUT4
 STA LOWSCR
 RTS
COUT4 STA HISCR
 RTS
BL1 DEC YSAV F(CR) CALLS HERE
 BEQ RTS5 CR ONLY SO IGNORE 
BLANK DEX 
 BNE SETMDZ
 CMP #$BA
 BEQ BLNK2
 LSR A
 JMP XAM
BLNK2 STA MODE F(:) 
 LDA A2L
 JSR YPOKE Y=0
 INC A5L HSF BYTE COUNT
 INC A3L
 BNE RTS5
 INC A3H
RTS5 RTS 
OUTEQ LDA #$BD
 BNE COUT
SETMODE LDA #0
 STA A5L CLEAR HSF BYTE COUNT
 LDY YSAV 
 LDA IN-1,Y EQUALS :,+,- OR . MODE 
SETMDZ STA MODE
 RTS 
LT LDX #$01 F(<) 
LT2 LDA A2L,X COPY A2 TO A4 
 STA A4L,X
 DEX 
 BPL LT2
 INX  BRKADDRH = 0
 STX BRKADDR+1 FLAGS BREAKPOINT GIVEN
 RTS 
MOVE JSR A1PCX F(M) A4<A1.A2M
 LDA A4L
 LDY A4H
 JSR A3SET
 JSR PEEK 
 JSR YPOKE
 JSR NXTA4 INCREMENTS A1 AND A4 
 BCC MOVE CARRY CLEAR IF A1<A2 
 RTS 
LIST JSR A1PC F(L) 
 JSR SETBREAK NNNN<300L WILL STOP LIST
LIST2 JSR INSTDSP AT NNNN
 JSR PCADJ  
 JSR CTRLC
 BEQ LISTRTS CTRL-C = EXIT TO NEXTITM
 LDA #$70 LIST SCROLL RATE
 JSR WAIT
 SEC  COMPARE PC TO BRKADDR
 LDA PCL
 SBC BRKADDR
 STA A5L TEMP USE
 LDA PCH
 SBC BRKADDR+1
 ORA A5L
 BCC LIST2 TAKEN IF PC < BRKADDR. 
LISTRTS RTS  RTS TO NEXTITM
A1PCX LDX #1
A1PC TXA  X=0 IF NO # GIVEN
 BEQ RTS6
A1PCLP LDA A1L,X X=1
 STA PCL,X
 DEX 
 BPL A1PCLP
 STZ JFLG
RTS6 RTS 
SETPRNT LDA SWITCH2 F(P)
 LDA MCSWL SAVE CURRENT MONITOR
 LDY MCSWH OUTPUT HOOK.
 STA CSWL
 STY CSWH
 LDA #1 EXECUTE PR#1
 JSR OUTPORT
 LDA #$8D #1019 SENT CR TO PRINTER
 JSR PR1 TO INIT MCSWL
 LDY MCSWL RESTORE OLD MONITOR
 LDA CSWL OUTPUT HOOK AND SET
 STA MCSWL COUT TO PRINTER BY
 STY CSWL EXCHANGING CSW'S.
 LDY MCSWH
 LDA CSWH
 STA MCSWH
 STY CSWH
 RTS
EXDOS LDX #9 F(&) = EXIT TO DOS
EXDS1 LDA DOSTR-1,X BY PUTTING 3F5<3D0G
 STA IN-1,X INTO INPUT BUFFER
 DEX  AND PARSING
 BNE EXDS1
 JMP PARSE
GO JSR A1PC F(G)
 LDA BRKADDR+1 'GO' WITH NO BREAKPOINT
 BEQ GOBREAK GIVEN EXECUTED AS 'JUMP'
 JMP TRCPCG WITH NO PARM BYTES.
GOBREAK LDA A4L
 STA PCL
 LDA A4H
 STA PCH
 LDY #2 'GO' WITH BRKPOINT GIVEN
LOADRT JSR YPEEK SAVES 3 BYTES FROM BREAK
 STA XQT+3,Y ADDR (XQT+3 = TEMP) AND
 LDA RTENTRY,Y PUTS JSR REENTER IN ITS
 JSR YPOKEPC PLACE WHICH WILL CAUSE
 DEY  A REAL TIME RE-ENTRY TO
 BPL LOADRT TO ANALYST.
 LDA #$4C PUT JMP PC INTO XQT
 STA XQT
 LDA A1L A1 = PC
 STA XQT+1
 LDA A1H
 STA XQT+2
 LDX SPNT
 TXS
XQJ LDX #2
XQJ2 LDA INITBL3,X
 STA XQTS+3,X
 DEX
 BPL XQJ2
 JSR RESTORE
 JMP XQTS
INITBL3 JMP XQT DUMMY STATEMENT
RESTORE LDA STATUS RESTORE REGS
 PHA
 JSR ZSWAPT GET PROGRAM 0 PAGE 
 LDA ACC
 LDX XREG
 LDY YREG
 PLP
 RTS
SAVE PHP 
 STA ACC 
 PLA 
 STA STATUS 
 CLD
 STX XREG
 STY YREG
ZSWAPT LDA ZFLG SWAP ALL IF ZFLG = $AA
 CMP #$AA ELSE SWAP ONLY PCL-BASH
 BNE ZSWAPS
ZSWAP LDX #BAS2H-PCL SWAP ALL
 DFB $2C
ZSWAPS LDX #BASH-PCL
ZSWP1 LDA PCL,X
 LDY ZBUF,X
 STY PCL,X
 STA ZBUF,X
 DEX
 BPL ZSWP1 
ZSWAPRTS RTS
ZSWAPE LDA ZFLG SWAP ZFLG-BAS2H IF ID
 CMP #$AA NOT PRESENT.
 BEQ ZSWAPRTS
 JSR ZSWAP SWAP ZFLG-BAS2H ONLY.
 BRA ZSWAPS
INITXQTS LDX #55
INITXQ2 LDA INITBL,X
 STA WARMV,X
 DEX
 BPL INITXQ2
 RTS
TXTMON JSR TEXTNG
 BRA PRHOME
RTENTRY JSR WARMV DUMMY STATEMENT.
REENTER JSR SAVE REAL-TIME RE-ENTRY
 JSR ZSWAPE WHICH IS CALLED AS
 PLA  A SUBROUTINE WITH PLA
 SEC  PLA TO SET PC FROM
 SBC #2 CALLER ADDRESS. RESTORES
 STA PCL ORIGINAL 3 BYTES TO BREAK
 PLA  ADDRESS.
 SBC #0
 STA PCH
 TSX
 STX SPNT
 LDY #2
RTREST LDA XQT+3,Y
 JSR YPOKEPC
 DEY
 BPL RTREST
 JSR SAVEPC
RESET JSR TEXTNG
 CLD 
 LDX #$FF
 TXS
 LDA ZFLG
 CMP #$AA
 BEQ RST2 IF ID NOT PRESENT 
 JSR ZSWAP THEN SWAP 0 PAGE 
 LDA #$AA & SET ID --> ZFLG:AA 
 STA ZFLG
RST2 JSR INITXQTS
 STZ TFLG
 STZ JFLG
PRHOME JSR HOME
 JSR PRTITLE
MONZ STZ ERRFLG
 STZ ASFLAG #1022
 DEC BRKADDR+1 INSURE BRKPOINT CLEARED
 JSR CHKVID MATCH HOOKS W/DISPLAY MODE
 JSR STPRMPT
 JSR GETLNZ 
PARSE JSR ZMODE
 STZ DSPTOP DISPLAY AT TOP
NXTITM JSR GETNUM HANDLE HEX DIGS TO 1ST 
 STY YSAV NON-HEX CHAR+1 (Y=INDX)
 LDY #SUBTBL-CHRTBL 
CHRSRCH DEY  ACC = F(ACC) 
 BMI SYNERR
 CMP CHRTBL,Y
 BNE CHRSRCH
 PHY
 JSR TOSUB
 PLY
 BEQ MONZ 0 = OFFSET FOR F(CR)
NEXTITM LDY YSAV
 BRA NXTITM
SYNERR JSR BELL
 BRA MONZ
DIG LDX #$03 HEX DIGIT NOW IN ACC LO 
 ASL A NIBBLE. KEYS 0-9=00-09 
 ASL A KEYS A-F=FA-FF. MOVE 
 ASL A LO NIBBLE TO HI NIBBLE 
 ASL A
NXTBIT ASL A 4 BIT HEX DIG. INTO A2L 
 ROL A2L A2L TO A2H 
 ROL A2H
 DEX 
 BPL NXTBIT
NXTBAS LDA MODE
 BNE NXTBS2 IF MODE=0 COPY 
 LDA A2H,X A2 TO A1 & A3
 STA A1H,X
 STA A3H,X
NXTBS2 INX 
 BEQ NXTBAS
 BNE NXTCHR
GETNUM LDX #0
 STX A2L
 STX A2H
NXTCHR LDA IN,Y F(ACC) = ACC EOR $B0
 INY  ADC $88 (CARRY SET)
 EOR #$B0 KEYS 0-9=$00-09 
 CMP #$0A
 BCC DIG TAKEN IF KEYS 0-9 
 ADC #$88 KEYS A-F=$FA-FF 
 CMP #$FA 
 BCS DIG TAKEN IF KEYS A-F 
 RTS 
TOSUB TYA  # OF FUNCTION (START=0)
 ASL A MULT BY 2 
 TAY
 LDA SUBTBL+1,Y 
 PHA
 LDA SUBTBL,Y
 PHA 
 LDA MODE OLD MODE FOR F(CR)&F( ) 
ZMODE LDY #$00
 STY MODE
 RTS  RTS TO SUBROUTINE 
EXECJSR LDA JFLG F(J) 
 BNE GOJSR 'J' WITH NO JSR?
ERRJ JMP BELL RTS TO NEXTITM VIA BELL.
GOJSR LDY YSAV GET # OF PARM BYTES
 JSR GETNUM
 DEY
 STY YSAV
 LDA A2H
 BNE ERRJ
 LDA A2L
 CMP #10
 BCS ERRJ ONLY 9 PARM BYTES MAX
 TAY  SAVE BYTE COUNT 
GOPC LDX #17 
XQINIT2 LDA INITBL2,X FILL DUMMY BLOCK
 STA XQT,X
 DEX
 BPL XQINIT2
 LDA PCL MOVE JSR ADDR TO XQT
XQLOC1 STA XQT+1
 LDA PCH
 STA XQT+2
 LDX SPNT SET PC = PARM LIST - 1 
 INX
 LDA STACK,X
 STA PCL
 INX
 LDA STACK,X
 STA PCH
 STX SPNT
 TYA  GET PARM BYTES 
 TAX
 BEQ MVPRM1 NO PARM BYTES TO MOVE
MOVPARM JSR YPEEK MOVE PARM LIST TO DUMMY
 STA XQT+2,Y 
 DEY 
 BNE MOVPARM
MVPRM1 INX 
 TXA  ADJ PC TO POINT TO INST 
 CLC  FOLLOWING PARM LIST
 JSR PCADJAP
 JMP XQJ EXECUTE JSR IMMED. MODE
INITBL2 JSR $0000 DUMMY BLOCK FOR F(J)
 NOP  9 NOP'S FOR PARM BYTES
 NOP
 NOP
 NOP
 NOP
 NOP
 NOP
 NOP
 NOP
 JSR XQTS+36 RESTORE ANALYST R/W
 JMP JRTS
JRTS JSR SAVE
 JSR CHKVID
 LDA JFLG
 BEQ JRTS3 DURING 'G0' W/O BREAK
 STZ JFLG
 LDA TFLG
 BEQ JRTS2 DURING 'STEP'
 JMP TRACE5 DURING TRACE IMMEDIATE
JRTS2 DEC DSPTOP UPDATE REGDSP AFTER JSR.
JRTSX JSR CLEARDSP 'SKIP' ENTERS HERE
 JMP NXTPC
JRTS3 RTS  RTS TO NEXTITM.
FIND LDA #$FF F(CTRL-F) A4<A1 CTRL-F
 STA A1L HEX SEQUENCE FINDER
 STA A4L
 DEC A4H
 LDX A5L
 STX XQT BYTE COUNT
 DEX
 BNE FXEND
 LDA A1H
 CMP #$FF
 BNE FXEND
 DEC A1L
FXEND DEC A1L
 DEX
 BNE FXEND
INCBAS INC A4L
 BNE TESTEND
 INC A4H
 LDA A4H
 CMP #$C0
 BNE TESTEND
 INC A4H
TESTEND LDA A1H
 CMP A4H
 BCC DONE
 BNE SETTMP
 LDA A1L
 CMP A4L
 BCC DONE
SETTMP LDA A4H
 STA PCH
 LDA A4L
 CLC
 ADC XQT
 STA PCL
 BCC SETX
 INC PCH
SETX LDX XQT
 INX
CHGTMP SEC
 LDA PCL
 SBC #$01
 STA PCL
 BCS CMPNUM
 DEC PCH
CMPNUM JSR PEEK
 DEX
 CMP XQT,X
 BNE INCBAS
 LDA PCL
 CMP A4L
 BNE CHGTMP
 LDX A4L
 LDA A4H
 JSR PRNTAX
 JSR OUTSP 
 BRA INCBAS
DONE JMP CROUT 
RELOC LDA STARTLOC+1 F(R)
 STA PCH
 STZ PCL MAKE SURE ANALYST IS
 JSR PEEK BEING READ FOR MOVE
 CMP #$F8 BY PEEKING START BYTE.
 BNE DONE DO NOT RELOCATE!
 LDA A1H
 STA A4H NEW ORIGIN PAGE
 PHA
 STZ A4L PAGE ALIGNED
 LDA STARTLOC+1
 STA A1H
 STA A5L
 STZ A1L
 LDA ENDLOC+1 LOCATION OF 'PGMEND' #1020
 STA A2H WHICH MARKS END OF MOVE
 STZ A2L PAGE ALIGNED #1020
 LDA A1H CALC DIFFERENCE BETWEEN
 SEC  OLD & NEW ORG
 SBC A4H
 STA A5H
 LDA #GBASE-SUBTBL #1020
 LSR A DIVIDE BY 2
 TAY  # OF WORDS
 LDX #$FF
RELOC2 INX  CONVERT SUBTBL WORDS
 INX
 LDA SUBTBL,X
 SEC
 SBC A5H
 STA SUBTBL,X
 DEY
 BNE RELOC2
 JSR MOVE NEW ORG<START.PGMEND
 PLA
 STA PCH
 STA NEWGO+2
 STZ PCL PAGE BOUNDARY ONLY.
 INC A2H
 LDA CHAR1LOC+1 END OF STATIC PGM AREA #1020
 STA A4L
 LDA CHAR1LOC+2
 SEC
 SBC A5H
 STA A4H
RELOC3 JSR INSDST
 LDY LENGTH
 CPY #2 3-BYTE INSTRUCTION ?
 BCC NABS
 JSR PEEK
 CMP #$2C
 BEQ NABS IGNORE BIT ABSOLUTE
 LDY #2 LENGTH
 JSR YPEEK
 LDX A2H IF OLD END WAS $FFNN
 BEQ CHKLO THEN DON'T CHECK ABOVE !!
 CMP A2H SEE IF WITHIN OLD
 BCS NABS START-END.
CHKLO CMP A5L
 BCC NABS
 SBC A5H CONVERT TO NEW ADDR
 JSR YPOKEPC
NABS JSR PCADJ
 CMP A4L SEE IF PC < NEW END OF
 TYA  STATIC PGM AREA. Y=PCH
 SBC A4H
 BCC RELOC3
NEWGO JMP START RUN NEW ORG
SETDOS TXA  F(/) SET OR PRINT DOS
 BNE SETDS2 SUBROUTINE TO JSR IMMED.
 LDA DOSCALL+1 '/' ALONE PRINTS ADDRESS
 LDX DOSCALL
 JSR PRNTAX
 JMP CROUT
SETDS2 LDA A1L,X NNNN/ COPIES NNNN INTO
 STA DOSCALL,X DOSCALL
 DEX
 BPL SETDS2
 RTS
AUXRW LDA PROMPT F(X) TOGGLE BETWEEN
 CMP #$A3 MAIN/AUX $200-BFFF R/W
 BNE AUX2MAIN
 LDA #$03
 LDY #$05
 BRA RWSET
AUX2MAIN LDA #$02
 LDY #$04
RWSET STA XQTS+44
 STY XQTS+47
STPRMPT LDA XQTS+44
 LSR A
 BCC SPROMPT
 LDA #$FD '}'
 DFB $2C
DPROMPT LDA #$A4 '$'
 DFB $2C
SPROMPT LDA #$A3 '#'
 STA PROMPT
 RTS
CHKVID LDA RD80VID RESET 40/80 COL IF NEEDED
 ASL A BIT 7 INTO CARRY
 LDA FLG8
 BMI CHK80
 BCC RTS7
 BCS SET80 40 -> 80
SETVID LDY YSAV F(@)
 LDA IN,Y
 INC YSAV
 CMP #$B8 '8'
 BEQ SET80
 CMP #$B4 '4'
 BEQ SET40
 CMP #$B1 '1'
 BNE CKGR2 
 LDY #$20 HGR
 BRA SETGR
CKGR2 CMP #$B2 '2'
 BNE ATSIGN
 STA ENAPAGE2 ENABLE GRAPHICS PAGE 2
 LDY #$40 HGR2
SETGR JSR INITGR SET COUT TO GRAPHICS
 JMP VTAB
CHK80 BCC SET40 80 -> 40
RTS7 RTS
TEXTNG LDA RDTEXT DO TEXT IF NOT IN GRAPHICS MODE
 BMI TEXT
 LDY GBASE
 BRA SETGR
ATSIGN DEC YSAV @ ALONE
TEXT STA LOWSCR #1007 SO TEXT RECOVERS FROM HGR2
 STA TXTSET
 STA INHPAGE2 #1009 SO TEXT RECOVERS FROM @2 IN AUX
 LDA OUTVECT
 STA CSWL
 LDA OUTVECT+1
 STA CSWH
 LDA RD80VID SET 40 OR 80 COL
 BPL SET40 TEXT BASED ON RD80VID
SET80 LDA #$FF
 STA FLG8
 LDA #80
 STA WNDWDTH
 BIT RD80VID
 BMI SET8D
 STA SET80VID
 LDA #$00
SET8A PHA 
 JSR VTABZ
 LDY #$00
SET8B LDA (BASL),Y
 TAX 
 PHY 
 TYA 
 LSR A
 TAY 
 BCS SET8C
 STA HISCR
SET8C TXA 
 STA (BASL),Y
 PLY 
 STA LOWSCR
 INY 
 CPY #$28
 BCC SET8B
 TYA 
 JSR CLEOLZ
 PLA 
 INC A
 CMP #$18
 BCC SET8A
SET8D BRA SETDONE
SET40 STZ FLG8
 BIT RD80VID
 BPL SET4D
 STA CLR80VID
 LDA #$00
SET4A PHA 
 JSR VTABZ
 LDY #$27
SET4B TYA 
 LSR A
 PHY 
 TAY 
 BCS SET4C
 STA HISCR
SET4C LDA (BASL),Y
 PLY 
 STA LOWSCR
 STA (BASL),Y
 DEY 
 BPL SET4B
 PLA 
 INC A
 CMP #$18
 BCC SET4A
SET4D LDA #40
 STA WNDWDTH
SETDONE JMP VTAB
HELP LDY #0 F(?) LIST LAST 16 PC
HLP2 LDA PCBUF,Y ADDRESSES EXECUTED
 INY  DURING TRACE.
 LDX PCBUF,Y
 INY
 JSR PRNTAX
 CPY PCPNT
 BNE HLP3
 LDA #$BC
 JSR COUT
HLP3 JSR CROUT
 CPY #32
 BCC HLP2
 RTS
PRTITLE LDX #$00 F(V). PRINT TITLE 
PRTITL1 LDA TITLE,X
 BEQ PRADDR 
 JSR COUT
 INX
 BRA PRTITL1 
PRADDR LDA STARTLOC+1 PRINT ORIGIN ADDRESS
 JSR PRBYTE
 LDA #0
 JSR PRBYTE
 JMP CROUT
 CHN A128XGB.1023