10 REM > PROGLST
   20 REM *PrList <prog name>
   30 REM Lists a BASIC program file
   40 REM By J.G.Harston
   50 REM (C)
   60 OSARGS=&FFDA:OSFIND=&FFCE:OSBGET=&FFD7
   70 OSASCI=&FFE3:OSBYTE=&FFF4
   80 mcode%=&FFFF0900
   90 FOR P=0 TO 1
  100   P%=mcode%
  110   [OPT P*3
  120   .handle:BRK
  130   .num:.line_num:BRK:BRK
  140   .subnum:BRK:BRK
  150   .flag:BRK
  160   .r_flag:BRK
  170   .quotes:BRK
  180   \ Uses start of prog for vars
  190   ]
  200   P%=mcode%
  210   [OPT P*3
  220   .start
  230   LDX &24B:CPX #&FF:BNE basic_present
  240   BRK:OPT FNs(CHR$254+"BASIC not present"):BRK
  250   .basic_present
  260   LDA &F4:PHA:STX &F4:STX &FE30:\ Page in BASIC
  270   LDY #0:LDA #1:LDX #&A8:JSR OSARGS
  280   LDX &A8:LDY &A9:LDA #&40:JSR OSFIND
  290   CMP #0:BNE file_found
  300   BRK:OPT FNs(CHR$214+"File not found"):BRK
  310   .file_found
  320   STA handle:TAY
  330   JSR OSBGET:CMP #13:BEQ basic_file
  340   LDA #0:JSR OSFIND
  350   BRK:OPT FNs(CHR$254+"Not a BASIC file"):BRK
  360   .addrs
  370   OPT FNw(&806D):\ BASIC 1
  380   OPT FNw(&8071):\ BASIC 2
  390   OPT FNw(&0000):\ ?
  400   OPT FNw(&8071):\ HIBASIC
  410   OPT FNw(&8456):\ BASIC 4, Master
  420   OPT FNw(&8257):\ BASIC 4, Z80
  430   .basic_file
  440   LDA #5:LDX &8006:STX r_flag
  450   BMI set_up2:LDA &8008
  460   .set_up2
  470   ASL A:TAX:\ Find the address of the token table
  480   LDA addrs,X:STA &AB
  490   LDA addrs+1,X:STA &AC
  500   .line_loop
  510   LDA #0:STA quotes
  520   JSR OSBGET:BCS end_of_file
  530   STA line_num+1:JSR OSBGET:BCS end_of_file:\ Line number
  540   STA line_num:LDA #32:STA flag
  550   JSR pr_line
  560   JSR OSBGET:BCS end_of_file:\ Line length
  570   .pr_loop
  580   BIT &FF:BMI escape
  590   LDY handle:JSR OSBGET:BCS end_of_file
  600   BIT quotes:BNE in_quotes
  610   CMP #128:BCS do_token
  620   .in_quotes
  630   CMP #34:BNE not_a_quote
  640   LDA #255:EOR quotes:STA quotes:LDA #34
  650   .not_a_quote
  660   JSR OSASCI
  670   CMP #13:BNE pr_loop
  680   BEQ line_loop
  690   .escape
  700   .end_of_file
  710   LDA #0:JSR OSFIND
  720   PLA:STA &F4:STA &FE30:RTS
  730   .do_token:CMP #141:BEQ do_tok2
  740   JSR pr_token
  750   LDY handle:BNE pr_loop
  760   .do_tok2
  770   JSR OSBGET:BCS end_of_file:STA line_num+1
  780   JSR OSBGET:BCS end_of_file:STA line_num
  790   LDA line_num+1:ASL A:ASL A:PHA:AND #&C0:EOR line_num
  800   STA line_num:PLA:ASL A:ASL A:STA line_num+1
  810   JSR OSBGET:BCS end_of_file
  820   EOR line_num+1:STA line_num+1
  830   LDA #0:STA flag
  840   JSR pr_line:JMP pr_loop
  850   .pr_token:STA &A8
  860   LDA &AB:STA &A9:LDA &AC:STA &AA
  870   .loop1
  880   LDY #255
  890   .loop:INY
  900   LDA (&A9),Y
  910   BPL loop
  920   CMP &A8:BEQ got_it
  930   INY:INY:TYA:CLC:ADC &A9:STA &A9
  940   LDA #0:ADC &AA:STA &AA:JMP loop1
  950   .got_it
  960   INY:BIT r_flag:BMI pr_t_loop
  970   LDY #0:.pr_t_loop
  980   LDA (&A9),Y:BMI pr_t_end
  990   BEQ pr_t_end
 1000   JSR OSASCI:INY:BNE pr_t_loop
 1010   .pr_t_end:RTS
 1020   .pr_line
 1030   \ General purpose 16 bit decimal
 1040   \ printout routine.
 1050   \ num holds number. flag holds
 1060   \ leading character, or zero
 1070   \ eg 32 = leading spaces
 1080   \ eg 48 = leading zeros
 1090   \ eg 0 = no leading characters
 1100   LDA #&27:STA subnum+1
 1110   LDA #&10:STA subnum
 1120   JSR do_subtracts:\  10000s
 1130   LDA #&3:STA subnum+1
 1140   LDA #&E8:STA subnum
 1150   JSR do_subtracts:\ 1000s
 1160   LDA #0:STA subnum+1
 1170   LDA #&64:STA subnum
 1180   JSR do_subtracts:\ 100s
 1190   LDA #&0A:STA subnum
 1200   JSR do_subtracts:\ 10s
 1210   LDA num:ORA #48:JMP OSASCI:\ 1s
 1220   .do_subtracts
 1230   LDX #255
 1240   .loop
 1250   INX
 1260   SEC
 1270   LDA num:SBC subnum:STA num
 1280   LDA num+1:SBC subnum+1:STA num+1
 1290   BCS loop:CLC
 1300   LDA num:ADC subnum:STA num
 1310   LDA num+1:ADC subnum+1:STA num+1
 1320   TXA:BEQ zero
 1330   ORA #48:JSR OSASCI
 1340   LDA #48:STA flag
 1350   .zero_exit
 1360   RTS
 1370   .zero
 1380   LDA flag:BEQ zero_exit
 1390   JMP OSASCI
 1400 ]NEXT
 1410 PRINT"*SAVE PrList ";~mcode%;" ";~P%
 1420 END
 1430 DEFFNs(A$):$P%=A$:P%=P%+LENA$:=P*3
 1440 DEFFNw(A%):!P%=A%:P%=P%+2:=P*3