10 REM > PrList14/s
   20 REM By Jonathan Harston
   30 REM v0.10        1986 - Original version
   40 REM v1.00   -Jun-1990 - Version in The Micro User
   50 REM v1.10 09-Nov-1991 - '+' to colour tokens
   60 REM v1.20 15-Sep-1992 - Added Compact BASIC token address
   70 REM v1.30 16-May-1993 - '-' omits line numbers, LFs not Spooled
   80 REM v1.31 17-Feb-1995 - Searches for token table, crunched code
   90 :
  100 REM Syntax: *PrList (-)<afsp>
  110 :
  120 OSARGS=&FFDA:OSFIND=&FFCE:OSBGET=&FFD7
  130 OSNEWL=&FFE7:OSWRCH=&FFEE:OSBYTE=&FFF4
  140 :
  150 lptr=&A8:tptr=&A8:tok=&AA:flag=&AB:num=&AC:numsub=&AE
  160 :
  170 DIM mcode% &300:load%=&FFFF0900
  180 FOR P=0 TO 1
  190   P%=load%:O%=mcode%
  200   [OPT P*3+4
  210   \ Uses start of code for variables
  220   .tbase:BRK:BRK
  230   .handle:BRK
  240   .quotes:BRK
  250   .lflg:BRK
  260   ]
  270   P%=load%:O%=mcode%
  280   [OPT P*3+4
  290   .errNoBasic
  300   BRK:EQUB 249:EQUS "No BASIC":\BRK
  310   .errNotFound
  320   BRK:EQUB 214:EQUS "Not found":BRK
  330   .start
  340   LDA #1:LDX #&A8:LDY #0:JSR OSARGS      :\ Read command line
  350   LDX &24B:CPX #&FF:BEQ errNoBasic
  360   STY lflg:LDA &F4:PHA:TXA:JSR set_rom   :\ Page in BASIC
  370   LDA (lptr),Y:CMP #ASC"-":BNE done_minus
  380   ROR lflg:INC lptr:BNE P%+4:INC lptr+1
  390   .done_minus
  400   LDX lptr:LDY lptr+1:LDA #&40:JSR OSFIND
  410   TAY:BEQ errNotFound:STY handle
  420   JSR OSBGET:CMP #13:BEQ basic_file
  430   LDA #0:JSR OSFIND
  440   BRK:EQUB 254:EQUS "Not a BASIC file":BRK
  450   .basic_file
  460   :
  470   \ ==================================
  480   \ TokenInit - Find BASIC token table
  490   \ ==================================
  500   \ Needs to search for "AND",&80 or &80,"AND"
  510   \
  520   .TokenInit
  530   LDY #0:STY tptr:LDA #&80:STA tptr+1    :\ tptr=>ROM start
  540   .TokInitLp
  550   LDA #1:CLC:ADC tptr:STA tptr           :\ Inc. tptr
  560   LDA #0:TAY:ADC tptr+1:STA tptr+1
  570   LDA (tptr),Y:CMP #&80:BEQ TokInit2:DEY :\ Found &80
  580   .TokInit2
  590   INY:LDA (tptr),Y:CMP #ASC"A":BNE TokInitLp :\ Not "A"
  600   INY:LDA (tptr),Y:CMP #ASC"N":BNE TokInitLp :\ Not "AN"
  610   INY:LDA (tptr),Y:CMP #ASC"D":BNE TokInitLp :\ Not "AND"
  620   .TokInitOk
  630   LDA tptr:STA tbase:LDA tptr+1:STA tbase+1
  640   \ tbase=>Start of token table, =>&80,"AND" or =>"AND",&80
  650   :
  660   .line_loop
  670   LDA #0:STA quotes
  680   JSR bgetY:STA num+1:JSR bget:STA num+0 :\ Line number
  690   JSR bget:LDA #32:STA flag              :\ Skip line length
  700   BIT lflg:BMI P%+5:JSR PrNum16          :\ Print line number
  710   .pr_loop
  720   JSR bgetY:BIT &FF:BMI escape
  730   BIT quotes:BNE in_quotes
  740   TAX:BMI do_token
  750   .in_quotes
  760   CMP #34:BNE not_a_quote
  770   LDA #255:EOR quotes:STA quotes:LDA #34
  780   .not_a_quote
  790   JSR OSWRCH:CMP #13:BNE pr_loop
  800   LDX #0:JSR Osbyte3:TXA:PHA  :\ Read current output status
  810   ORA #16:TAX:JSR Osbyte3     :\ Turn "Spool" off
  820   LDA #10:JSR OSWRCH          :\ Output a line feed
  830   PLA:TAX:JSR Osbyte3         :\ Restore "Spool" status
  840   JMP line_loop
  850   :
  860   .bgetY
  870   LDY handle
  880   .bget
  890   JSR OSBGET:BCC not_eof:PLA:PLA
  900   .escape
  910   .end_of_file
  920   LDA #0:JSR OSFIND:JSR OSNEWL
  930   PLA:.set_rom:STA &F4:STA &FE30:.not_eof:RTS
  940   :
  950   .do_token:CMP #141:BEQ do_num
  960   JSR TokenPrint:JMP pr_loop
  970   :
  980   .do_num
  990   JSR bget:STA num+1:JSR bget:STA num+0
 1000   LDA num+1:ASL A:ASL A:PHA:AND #&C0:EOR num
 1010   STA num:PLA:ASL A:ASL A:STA num+1
 1020   JSR bget:EOR num+1:STA num+1
 1030   LDA #0:STA flag
 1040   JSR PrNum16:JMP pr_loop
 1050   :
 1060   \ =============================
 1070   \ PrToken - Print a BASIC token
 1080   \ =============================
 1090   \ tbase=>Start of token table, "AND",&80,n or &80,"AND"(,n)
 1100   \
 1110   .TokenPrint
 1120   PHA:LDA tbase:STA tptr           :\ Point to start token table
 1130   LDA tbase+1:STA tptr+1
 1140   .TokPrLp1
 1150   LDY #&FF
 1160   .TokPrLp2
 1170   INY:LDA (tptr),Y:BPL TokPrLp2    :\ Loop until token byte found
 1180   PLA:CMP (tptr),Y:BEQ TokPrFound  :\ Found matching token
 1190   PHA:TYA:BNE TokPrStep            :\ Step to next token
 1200   .TokPrLp3
 1210   INY:LDA (tptr),Y:BPL TokPrLp3    :\ Find next token byte
 1220   DEY:DEY
 1230   .TokPrStep
 1240   INY:TYA:SEC:ADC tptr:STA tptr    :\ Step past this token string
 1250   LDA #0:ADC tptr+1:STA tptr+1
 1260   BNE TokPrLp1                     :\ Loop to keep searching
 1270   .TokPrFound
 1280   TYA:BEQ TokPrNxt:LDY #0          :\ Skip past leading token
 1290   .TokPrLp3
 1300   LDA (tptr),Y:BMI TokPrEnd        :\ Token byte, end
 1310   CMP #32:BCC TokPrEnd:JSR OSWRCH  :\ Flag byte, end
 1320   .TokPrNxt
 1330   INY:BNE TokPrLp3                 :\ Loop back for next character
 1340   .TokPrEnd
 1350   RTS
 1360   :
 1370   .PrNum16
 1380   \ General purpose 16 bit decimal
 1390   \ printout routine.
 1400   \ num holds number. flag holds
 1410   \ leading character, or zero
 1420   \ eg 32 = leading spaces
 1430   \ eg 48 = leading zeros
 1440   \ eg 0 = no leading characters
 1450   LDY #&27:LDX #&10:JSR do_subs:\  10000s
 1460   LDY #&03:LDX #&E8:JSR do_subs:\  1000s
 1470   LDY #&00:LDX #&64:JSR do_subs:\  100s
 1480   LDY #&00:LDX #&0A:JSR do_subs:\  10s
 1490   LDA num:ORA #48:JMP OSWRCH   :\  1s
 1500   :
 1510   .do_subs
 1520   STX numsub+0:STY numsub+1:LDX #255
 1530   .loop
 1540   INX:SEC
 1550   LDA num+0:SBC numsub+0:STA num+0
 1560   LDA num+1:SBC numsub+1:STA num+1
 1570   BCS loop
 1580   LDA num+0:ADC numsub+0:STA num+0
 1590   LDA num+1:ADC numsub+1:STA num+1
 1600   TXA:BEQ zero
 1610   ORA #48:JSR OSWRCH
 1620   LDA #48:STA flag
 1630   .zero_exit
 1640   RTS
 1650   .zero
 1660   LDA flag:BEQ zero_exit
 1670   JMP OSWRCH
 1680   :
 1690   .Osbyte3
 1700   LDA #3:JMP OSBYTE
 1710   EQUS "1.14"
 1720   :
 1730 ]NEXT
 1740 PRINT"*SAVE PrList ";~mcode%;" ";~O%;" ";~start OR&FFFF0000;" ";~load%