BASIC PROGRAM LISTING UTILITY

To illustrate the use of Basic's token table, David Spencer presents a utility to list a program from a file.

The article elsewhere in this issue on the Basic token table shows how a token can be converted back into the corresponding keyword. This principle is used here to implement a utility to list a Basic program from a file, without having to first load it into memory. Two versions of the utility are given. The first is written in Basic, and has the advantage of being easy to follow if you wish to investigate how it works. The other version is in the form of a machine code utility which can be saved in the Library directory of your disc and used as required.

USING THE UTILITY

Using the Basic version of the utility is simplicity itself. Type in the program and save it, then run it and enter the file name of the program to be listed. The required file will then be listed just as if it had been loaded and LIST used.

To use the machine code version, type it in, save it and run it. This will assemble the utility and save it using the filename 'BLIST'. The command is invoked with:
*BLIST [P]
The parameter file is the filename of the Basic program to list. By placing a 'P' after the filename, for example:
*BLIST Prog P
the command will pause until a key is pressed. This allows discs to be swapped if the program to be listed is on a different disc to the actual command. Note however, that in this case the filename must specify the drive number, otherwise ADFS will not remount the disc.

10 REM >FLister
20 REM Program Basic Program List
30 REM Version A 1.0
40 REM Author David Spencer
50 REM RISC User April 1989
60 REM Program Subject to Copyright
70 :
80 DIM code 100
90 FOR pass=0 TO 2 STEP 2
100 P%=code:[OPT pass
110 STMFD R13!,{R14}:MOV R2,R14
120 ADR R12,temp:STR R1,[R12]
130 ADR R14,back:ADD PC,R2,#&4C
140 .back STR R1,temp:LDMFD R13!,{PC}
150 .temp EQUD 0:]NEXT
160 @%=&505:ON ERROR GOTO 590
170 INPUT "Enter filename "F$
180 X%=OPENIN F$
190 IF X%=0 ERROR &D6,"File not found"
200 Y%=FNget
210 IF Y%<>13 ERROR 0,"Not BASIC"
220 REPEAT L%=FNget
230 IF L%<>255 THEN
240 ln=256*L%+FNget:Y%=FNget
250 PRINT ln;" ";
260 REPEAT Y%=FNget
270 CASE TRUE OF
280 WHEN Y%=13
290 WHEN Y%=&8D:PROClref
300 WHEN Y%>&7F:PROCtoken(Y%)
310 OTHERWISE:VDU Y%
320 ENDCASE
330 UNTIL Y%=13
340 PRINT
350 ENDIF
360 UNTIL L%=255
370 CLOSE #X%
380 END
390 :
400 DEF FNget
410 IF EOF#X% THEN CLOSE#X%:END
420 =BGET#X%
430 :
440 DEF PROCtoken(A%)
450 IF A%>&C5 AND A%<&C9 THEN B%=FNget
460 CALL code:addr=!temp
470 WHILE ?addr<&7F
480 VDU ?addr:addr+=1
490 ENDWHILE
500 ENDPROC
510 :
520 DEF PROClref
530 no1=FNget<<2
540 no2=FNget EOR (no1 AND &C0)
550 no2=no2 OR ((FNget EOR ((no1<<2) AND &C0))<<8)
560 PRINT;no2;
570 ENDPROC
580 :
590 @%=&90A:IF X% THEN CLOSE#X%
600 PRINT REPORT$ " at line ";ERL
*********************************************
10 REM > FileList
20 REM Program ARM program lister
30 REM Version A 1.0
40 REM Author David Spencer
50 REM RISC User April 1989
60 REM Program Subject to Copyright
70 :
80 DIM code 1000
90 FOR pass=0 TO 2 STEP 2
100 P%=code
110 [OPT pass
120 LDR R0,[R14,#&4C]:TST R0,#&800000
130 BICEQ R0,R0,#&FF000000
140 ORRNE R0,R0,#&FF000000
150 ADD R1,R14,#&54
160 ADD R0,R1,R0,LSL #2
170 ADR R1,temp:STR R0,[R1]
180 MOV PC,R14
190 .temp EQUD 0:]
200 NEXT:CALL code
210 tokenaddr=!temp
220 :
230 FOR pass=4 TO 7 STEP 3
240 P%=0:O%=code
250 [OPT pass
260 SUB R13,R13,#256
270 STMFD R13!,{R14}
280 LDRB R0,[R1]:CMP R0,#ASC" "
290 LDMCCFD R13!,{R14}:ADRCC R0,err1
300 ORRCCS PC,R14,#1<<28
310 MOV R0,R1:MOV R2,#%101<<29
320 SWI "XOS_GSInit":MOV R3,R12
330 .readname SWI "XOS_GSRead"
340 BVS error2:MOVCS R1,#0
350 STRB R1,[R3],#1:BCC readname
360 SUB R0,R0,#2
370 .findq LDRB R1,[R0,#1]!
380 CMP R1,#32:BEQ findq:BCC open
390 BIC R1,R1,#&20:CMP R1,#ASC"P"
400 ADRNE R0,err2:LDMNEFD R13!,{R14}
410 ORRNES PC,R14,#1<<28
420 SWI "XOS_WriteS":EQUS "Insert disc
and press any key":EQUW &D0A:EQUB 0
430 MOV R0,#15:MOV R1,#1
440 SWI "XOS_Byte":SWI "XOS_ReadC"
450 .open MOV R0,#&48:MOV R1,R12
460 SWI "XOS_Find":BVS error2
470 STR R0,[R12]
480 BL get:CMP R0,#&D:BEQ ploop
490 MOV R0,#0:SWI "XOS_Find"
500 ADR R0,err3:LDMFD R13!,{R14}
510 ORRS PC,R14,#1<<28
520 .ploop BL get:MOV R2,R0,LSL #8
530 CMP R0,#&FF:BEQ end
540 BL get:ORR R0,R0,R2
550 ADD R1,R12,#4:MOV R2,#10
560 SWI "XOS_BinaryToDecimal"
570 RSB R1,R2,#5:.sl CMP R1,#0:BEQ sl2
580 SWI &120:SUB R1,R1,#1:B sl
590 .sl2 MOV R1,R2:ADD R0,R12,#4
600 SWI "XOS_WriteN":SWI &120
610 SWI "XOS_ReadEscapeState"
620 BCS end:MOV R3,#0:BL get
630 .ploop2 BL get:CMP R0,#&D
640 SWIEQ "XOS_NewLine":BEQ ploop
650 CMP R0,#&7F:SWICC "XOS_WriteC"
660 BCC ploop2:CMP R0,#&8D:BEQ lref
670 CMP R3,#0:SWINE "XOS_WriteC"
680 BNE ploop2:CMP R0,#&F4:MOVEQ R3,#1
690 CMP R0,#&C6:CMPNE R0,#&C7
700 CMPNE R0,#&C8:BEQ comp
710 BL tcall:B tkprt
720 .comp MOV R2,R0:BL get
730 STRB R0,[R12,#4]:ADD R12,R12,#4
740 MOV R0,R2:BL tcall:SUB R12,R12,#5
750 .tkprt LDRB R0,[R1],#1:CMP R0,#&7F
760 SWICC "XOS_WriteC":BCC tkprt
770 B ploop2
780 :
790 .lref BL get:MOV R2,R0,LSL #2
800 BL get:AND R1,R2,#&C0
810 EOR R0,R0,R1:MOV R4,R0
820 BL get:MOV R1,R2,LSL #2
830 EOR R0,R0,R1:AND R0,R0,#&FF
840 ORR R0,R4,R0,LSL #8
850 ADD R1,R12,#4:MOV R2,#10
860 SWI "XOS_BinaryToDecimal"
870 MOV R0,R1:MOV R1,R2
880 SWI "XOS_WriteN":B ploop2
890 :
900 .get LDR R1,[R12]:SWI "XOS_BGet"
910 BVS error:MOVCC PC,R14
920 SWI "XOS_NewLine"
930 .end LDR R1,[R12]:MOV R0,#0
940 SWI "XOS_Find":LDMFD R13!,{PC}^
950 :
960 .tcall STMFD R13!,{R14}
970 ADR R14,tcall2:LDR PC,tjump
980 .tcall2 LDMFD R13!,{PC}
990 .tjump EQUD tokenaddr
1000 :
1010 .error MOV R0,#0:LDR R1,[R12]
1020 SWI "XOS_Find"
1030 .error2 LDMFD R13!,{PC}
1040 :
1050 .err1 EQUD 100
1060 EQUS "No filename":EQUB 0:ALIGN
1070 .err2 EQUD 101
1080 EQUS "Bad qualifier":EQUB 0:ALIGN
1090 .err3 EQUD 102
1100 EQUS "Not a BASIC program":EQUB 0
1110 ]NEXT
1120 SYS "OS_File",10,"BLIST",&FFC,,code,O%