Listing of file='UTB.LIS2' on disk='vmedia/toolbox.wvd.zip'
# Sector 539, program filename = 'UTB.LIS2'
0010 REM UTB.LIS2 04/05/84 OFF LINE LIST OF SPOOLED T.C. FILES
0020 COM F$8,F1$8, H
0030 SELECT #4 005
0040 M=1
0050 DIM A$(4)62, O$(140)1, M$(1)2, P9$(3)50, B$1, C$1, D9$3, D5$20, I$3
0060 H$=HEX(020402000E)
: REM /.Highlight
0070 GOTO 850
0080 REM %VARIABLE MEANINGS
0090 REM %0 #0 Program disk, #1 List disk, #4 CRT, #5 Printer
0100 REM %0 A A, B B, C C, A$ A$64, B$ B$1, C$ C$1
0110 REM %0 A$( Read block area, E$ Error #, L$ Line number, I$ Recall Item #
0115 REM %0 D1$( Disk table, D5$ Printer data, D9$ Disk address
0120 REM %0 H 0=Printer 1=CRT, M List Mode
0130 REM %0 O$( Output area, F$ File name, F9$ Last file
0135 REM %0 H$ CRT hi intensity, I1 Sector, I2 Image #, I1 1st image #
0140 REM %0 M$( Match array, P Restart page #
0150 REM %0 Y1 Count, Y2 # bytes in blk, Y3 Ptr in blk
0160 REM %0 D Curr.line, E Lines per page
0170 REM % SPECIAL FUNCTIONS
0180 REM %^.Mainline
0190 REM %. READ/PRINT LOOP
0200 DATA LOAD DC #1, A$()
: ERRORGOTO 220
0210 C$=A$()
: I3=I2
: IF C$=HEX(00)OR C$=HEX(F0)THEN 230
0220 PRINT "File is not T.C. format"
: GOSUB 430
: RETURN
0230 Y2=VAL(STR(A$(1),2))
0240 Y3=3
: I1=I1+1
0250 I2=I2+1
: Y1=VAL(STR(A$(),Y3))
: REM /.Count
0260 GOSUB 310
: REM /.List S.R.
0270 Y3=Y3+Y1+1
: IF Y3<>Y2 THEN 250
0280 IF STR(A$(1),1,1)<>HEX(F0)THEN 200
0290 RETURN
0300 REM %.Determine list mode
0310 IF H<>1THEN 350
0320 REM .to CRT
0330 ON M GOSUB 520,460,490
: GOSUB 410
: RETURN
0340 REM .To printer
0350 GOSUB 370
: IF M=4THEN RETURN
: ON M GOSUB 520,465,500
: $IF ON #9,355
: RETURN
0355 ON F8GOTO 360
: KEYIN C$
: IF C$<>HEX(1F)THEN RETURN
: IF F8=0THEN F8=-1
0360 GOSUB 1400
: RETURN
0365 REM %.Test Printer ready
0369 PRINT HEX(07);"Printer NOT READY"
0370 A=0
0375 $GIO CHECK PRINTER #5(0100 0201 1212 4000 4000 4000,Z$)
: C$=STR(Z$,8)
0380 A=A+1
: IF A>999THEN 369
0390 IF C$=HEX(10)THEN 375
: RETURN
0400 REM %.Test KBD
0410 KEYIN B$,430,430
0420 RETURN
0430 KEYIN B$,420,440
: GOTO 430
0440 IF B$>HEX(03)THEN 445
: IF B$=HEX(00)THEN RETURN
: M=VAL(B$)
: PRINT "Now mode = ";M
: RETURN CLEAR
: RETURN CLEAR
: I2=I3
: GOTO 230
0445 IF B$>HEX(04)THEN RETURN
: RETURN CLEAR
: RETURN CLEAR
: RETURN
0450 REM %.List w/o Controls
0460 PRINT STR(A$(),Y3+1,Y1)
: RETURN
0465 PRINT "<<File = ";F$;" image = ";I2;TAB(60);HEX(0D);
0470 $GIO#5(A000400D,Z$)A$()<Y3+1,Y1>
: RETURN
0480 REM %.List in Hex
0490 PRINT "<<Data in Hex from file = ";F$;" sector = ";I1;" image = ";I2;"
count = ";Y1;">>"
: FOR A=1TO Y1
: PRINT HEXOF(STR(A$(),Y3+A,1));" ";
: IF A/20=INT(A/20)THEN PRINT
: NEXT A
: IF A/20<>INT(A/20)THEN PRINT
: RETURN
0500 SELECT PRINT <STR(P1$,1,3)>(120)
: C8=1
: PRINT "<<Data in Hex from file = ";F$;" sector = ";I1;" image = ";I2;"
count = ";Y1;">>"
: FOR A1=Y3+C8TO Y1+A1-C8
: PRINT HEXOF(STR(A$(),A1,1));" ";
: NEXT A1
: PRINT
: SELECT PRINT <F8$>(80)
: RETURN
0510 REM %^.List with line control
0520 Y1=Y1-1
: REM /.Count
: GOSUB 530
: Y1=Y1+1
: RETURN
0530 B$=STR(A$(),Y3+1)
: REM /Vertical line control
0535 C=Y1
: INIT(" ")O$()
0540 MAT COPY A$()<Y3+2,Y1>TO O$()<1,Y1>
: REM /.Copy data
0550 REM %.to CRT
0560 IF H<>1THEN 630
: REM /.Jump if printer output
0570 PRINT "<<File = ";F$;" image = ";I2;
0580 PRINT " Line control = ";
0590 IF B$<"/"OR B$>"M"THEN PRINT " x'";HEXOF(B$);"' is invalid";
: ELSE PRINT B$;
: PRINT " Length=";Y1;" >>"
0600 PRINT STR(O$(),1,Y1)
0610 IF H=1 THEN RETURN
: REM /.Jump if CRT output only
0620 REM %.to Printer
0630 PRINT "<<File = ";F$;" image = ";I2;TAB(60);HEX(0D);
0635 IF B$="@"THEN 830
: REM /.@ control is Vertical Format Control Record
0640 IF P=0THEN 648
: IF B$<>"A"THEN RETURN
: P=P-1
: IF P>0THEN RETURN
: REM /.restart at page
0648 GOSUB '38(C,B$,O$(),Q)
: RETURN
0810 REM %^. FORMS CONTROL FROM DATA RECORD
0820 REM BYTE 1 OF RECORD WILL CONTAIN @ AT SYMBOL
0830 P9$="@"
: MAT COPY O$()<1,Y1>TO P9$()<1,Y1>
: B$="M"
: MAT SEARCHP9$()<1,99>,=B$TO M$()
: B=VAL(STR(M$(1),2))
: IF B>0THEN E=B
: RETURN
0840 REM %^ Initialization
0850 F8=0
: GOSUB 1400
: IF P1$<>" "THEN 860
: H=1
: P1$="CRT"
0860 IF D1$(10)=" "THEN 1180
: D1$(10)=" "
0870 SELECT PRINT <F8$>
: PRINT HEX(03);H$;"LIST selected T.C. data files";HEX(0F)
0880 PRINT AT(0,40,40);"OUTPUT TO ";P1$
: A,F1=0
0890 A=A+1
: F$=F$(A)
: IF F$=" "THEN 1170
: F1=F1+1
: IF STR(F$(A),12,1)<>" "THEN 890
0900 D9$=STR(F$(A),9,3)
: SELECT #1<D9$>
: PRINT AT(1,0,40);"ON DISK = ";D9$
0910 IF H=1THEN 930
: IF M=4THEN 930
: PRINT AT(6,0)
: PRINT H$;"READY LINE PRINTER ";P1$;HEX(0F)
0920 IF STR(F$,8,1)="A"OR H=2THEN $GIO TOP OF FORM #5(400D 400C)
0930 PRINT AT(1,40,40);"Listing file ";F1;" of ";F
0940 REM %.?3
0950 A$="DATA FILE NAME ="
: PRINT AT(3,0,20*80);A$
0960 F$=F$(F1)
: REM LINPUT -F$
: F1$=F$
: D=1
0970 PRINT AT(2,0,80);A$;" ";F$
0980 REM %.?4
0990 A$="OUTPUT MODE ="
: PRINT AT(3,0,20*80);A$
0995 IF H=1THEN 1000
: IF M1>0THEN 1010
: M1=1
1000 INPUT "1=With line control 2=w/o line control 3=hex notation 4=No"M
1010 M=INT(M)
: IF M<1OR M>4THEN 990
: RESTORE LINE1010,M
1020 READ D5$
: DATA "With line control","w/o line control","hex notation","no"
1030 PRINT AT(2,40);A$;M;"=";D5$
: PRINT AT(3,0,20*80)
1040 PRINT
: IF M=4THEN 1110
1045 IF M=1THEN GOSUB '37(V0$)
: REM /.Setup PRINT S.R.
1050 REM %.Read data file for listing
1060 PRINT H$,"<<<<<< TRYING TO READ FILE = ";F$;" >>>>>>";HEX(0F)
1070 I1,I2=0
: E=66
: REM /LINES PER PAGE
1080 DATA LOAD DC OPEN T #1,F$
: REM .ERR 80 NO SUCH FILE
1090 A=0
1100 GOSUB 200
1110 F9$=F$
1120 PRINT "<<<<<<<< End of file = ";F$;" >>>>>>>>"
: IF H<>1THEN 1150
1130 PRINT "Key '0 ABORT '7 = BEGIN same file again Q = see Q anything el
se continue"
1140 KEYIN C$
: IF C$=HEX(00)THEN 1340
: IF C$=HEX(07)THEN 870
: IF C$="Q"THEN 1180
1150 STR(F$(F1),12)=".done"
: GOTO 870
1160 REM %^.Queue display
1170 A$="LISTing complete of selected T.C. data files"
: GOSUB 1200
: GOTO 1230
1180 A$="LIST Queue of selected T.C. data files"
: GOSUB 1200
: GOTO 1230
1190 REM %.S.R. Show queue file items
1200 PRINT HEX(03);H$;A$;;HEX(0F)
: PRINT AT(3,0);
: A=0
1210 A=A+1
: F$=F$(A)
: IF F$=" "THEN RETURN
: PRINTUSING " ### ######## ########";A;F$;STR(F$(A),9,8);
: IF A/3=INT(A/3)THEN PRINT
: GOTO 1210
1220 REM %.Wait for KBD on queue display
1230 PRINT AT(1,0);"Key '0 to ABORT '15 to RECALL to point in queue Else
anything"
: KEYIN C$
: IF C$=HEX(00)THEN 1340
: IF C$=HEX(0F)THEN 1240
: GOTO 870
1240 CONVERT F1 TO I$,(###)
: PRINT AT(1,0,80);"RECALL to queue item ";
: LINPUT -I$
: CONVERT I$TO A
: ERRORGOTO 1240
1250 IF A<1OR A>FTHEN 1240
: F1=A
: FOR A=1TO F1-1
: STR(F$(A),12)=".done"
: NEXT A
: FOR A=F1TO F
: STR(F$(A),12)=" "
: NEXT A
: GOSUB 1200
1255 M1=0
: F$=F$(F1)
: REM /.start with file
1260 P=1
: CONVERT P TO I$,(###)
: PRINT AT(1,0,80);"starting page ";
: LINPUT -I$
: CONVERT I$TO P
: ERRORGOTO 1260
1270 P=ABS(P)
: IF P>0THEN P=P-1
: GOTO 870
1280 REM %.Error handling
1290 ON ERROR E$,L$GOTO 1300
1300 IF E$="D82"THEN 1310
: PRINT "ERR ";E$;" LINE = ";L$;" NOT TRAPPED"
: END
1310 F$=F9$
: PRINT "LAST FILE PROCESSED = ";F$
1320 PRINT "NO MORE FILES SEQUENTIALLY STORED"
1330 STOP "KEY '0 TO EXIT OR RUN (EXEC) TO RERUN JOB"
1340 DEFFN'0
: INIT(" ")F$()
: F=0
: LOAD DC T#0,"START"
1350 REM %.Foreground/Background
1360 REM .F8$ PRINT #9 F8 Meaning
1361 REM .005 005 /001 -1 Foreground (background possible)
1362 REM .005 005 /001 0 Foreground ONLY
1363 REM .000 000 /005 +1 Background
1400 F8=-F8
: ON F8+2GOTO 1410,1410,1420
1410 F8$="005"
: SELECT #9/001,PRINT <F8$>,#4<F8$>
: RETURN
1420 F8$="000"
: SELECT #9/005,PRINT <F8$>,#4<F8$>
: $RELEASE TERMINAL
: RETURN
8000 REM %^.PRINTSUB
8004 DIM Q0$64,Q1$(4)62,Q2$(128)2,Q3$(128)2,Q4$1,Q5$(16)2,Q7$(132)1,Q9$(1)2
8005 REM %0 #5 PRINTER, '36 WHICH VFU, '38 PRINT S.R., '39 PRINTER READY?
8006 REM %0 V0$ VFU
8008 REM %0 Q Printer 1=2235, Q0$ LF/VT DECODE ARRAY
8010 REM %0 Q1$( (4)62 DATA ARRAY, Q1 # Q1$ BYTES
8012 REM %0 Q2$( (128)2 VFU TAPE, Q2 # VFU LINES
8014 REM %0 Q3$( (128)2 VFU W/A, Q3 # LINES/INCH
8016 REM %0 Q4$ LINE CTRL BYTE, Q4 0=POST 1=PRE
8018 REM %0 Q5$( (16)2 VFU MASK, Q5 F.FEED 0=N 1=Y
8020 REM %0 Q6 CURR.LINE #, Q8 BOT.OF FORM
8022 REM %0 Q7$( L.FEED ARRAY, Q7 # L.FEEDS
8024 REM %0 Q9$( (1)2 MATCH AREA
8026 REM %^.'38 PRINT SUBROUTINE
8030 DEFFN'38(Q1,Q4$,Q1$(),Q)
8070 Q6=Q6+1-SGN(Q6)
: Q4=INT(VAL(Q4$)/128)
: AND (Q4$,7F)
: INIT(20)STR(Q1$(),Q1+1)
: $TRAN(Q4$,Q0$)R
: IF Q4$<HEX(10)THEN 8090
: AND (Q4$,0F)
: Q7=VAL(Q4$)
8080 Q6=Q6+Q7-Q2*INT((Q6+Q7-1)/Q2)
: IF Q7=0OR Q4=1OR Q1>132THEN Q1=132
8085 $GIO#5(013002FF1212407F,Q$)
: IF Q4=0THEN GOSUB 8200
: IF Q5=1THEN $GIO#5(013002FF1212400C,Q$)
: $GIO#5(013002FF1212A000,Q$)Q7$()<1+Q+Q5,Q7>
: IF Q4=1THEN GOSUB 8200
: IF STR(Q$,8,1)=HEX(10)THEN 8088
: Q5=0
: RETURN
8088 PRINT "PRINTER NOT READY"
: GOTO 8085
8090 REM VERT.TAB
: IF Q4$<>HEX(01)THEN 8100
: REM FORMFEED
: Q5,Q6=1
: Q7=0
: GOTO 8080
8100 Q3$()=STR(Q5$(VAL(Q4$)),1,2)&STR(Q3$())
: Q3$()=Q3$()AND Q2$()
: MAT SEARCHQ3$()<3,2*Q2>,<>" "TO Q9$()STEP 2
: Q7=1
: IF Q9$()=" "THEN 8080
8110 MAT SEARCHQ3$()<3+2*Q6,2*Q2-2*Q6>,<>" "TO Q9$()STEP 2
: Q7=INT((VAL(Q9$(1),2)-1)/2)+1
: IF Q9$()<>" "THEN 8080
: Q8=Q6
: Q5,Q6=1
: IF Q2=Q8THEN Q5,Q6=0
: GOTO 8110
8200 $GIO#5(013002FF1212A000 1E43 E0FF 400D,Q$)Q1$()<,Q1>
: RETURN
8400 REM %.INITIALIZATION
8410 DEFFN'37(V0$)
: IF V0$=" "THEN 8430
: DATA LOAD DC OPEN T#0,V0$
: ERRORX7=ERR
: STOP "NO VFU"
8420 Q2=99
: INIT(" ")Q2$()
: DATA LOAD DC #0,Q0$, Q2$(),Q2
: ERRORX7=ERR
: STOP "ILLEGAL VFU"
8430 IF Q2<=0THEN Q2=66
: Q7$()=ALL(0A)
: Q7$(1)=HEX(0D)
: Q5$()=" "
: Q0$=HEX(10301131123213331434153516361737183819390141024203430444054506460
747084809490A4A0B4B0C4C112F)
8440 STR(Q$,3,2)=BIN(Q,2)
: RETURN