image of READY prompt

Wang2200.org

Listing of file='609RCVR2' on disk='vmedia/701-2737G.wvd.zip'

# Sector 1036, program filename = '609RCVR2'
0010 REM '609RCVR2' - TEST AND REBUILD VTOC IN NECESSARY
0170 COM J2$(84)6,D6
   : MAT REDIM C6$(256)1
   : DIM D2$(256)1,C0$53,C3$2,C4$3,D4$(84)2,D5$(84)2,J$(84)6
   : D6=0
   : INIT(00)J2$()
   : DATA LOAD BA T#6,(D1+12)C6$()
   : ERRORGOTO 350
0250 GOSUB 790
   : IF B2$<>" "THEN 350
   : IF D6<42THEN 1050
   : DATA LOAD BA T#6,(D1+1)C6$()
   : ERRORGOTO 350
0300 GOSUB 790
   : IF B2$<>" "THEN 350
   : GOTO 1050
0350 INIT(00)J2$()
   : GOSUB 2505
   : PRINT HEX(06);AT(8,0,79);TAB(33);B2$
   : D6=0
   : FOR C=1TO 1231
   : DATA LOAD BA T#6,(D1+C)C6$()
   : ERRORGOTO 740
0420 IF C6$(3)<>HEX(FF)OR C6$(4)<>"A"THEN 740
   : C5$=STR(C6$(),8,5)
   : AND (C5$,7F)
   : CONVERT STR(C5$,1,4)TO J6
   : ERRORGOTO 740
0460 IF POS(C0$=STR(C5$,5,1))=0THEN 740
   : UNPACK(####)STR(C6$(),5,2)TO J6
   : ERRORGOTO 740
0480 IF POS(C0$=STR(C6$(),7,1))=0THEN 740
   : GOSUB 2510
   : PRINT HEX(06);AT(10,0,79);TAB(20);B2$;" ";C5$
   : MAT SEARCHJ2$(),=STR(C6$(),5,3)TO T2$STEP 6
   : IF T2$<>HEX(0000)THEN 590
   : D6=D6+1
   : GOSUB '51(C)
   : J2$(D6)=STR(C6$(),5,3)&STR(D9$,1,2)&HEX(00)
   : GOTO 740
0590 GOSUB '50(STR(J2$(),VAL(T2$,2)+3,2))
   : DATA LOAD BA T#6,(D1+J)D2$()
   : IF STR(C6$(),184,2)<STR(D2$(),184,2)THEN 740
   : IF STR(C6$(),178,2)<STR(D2$(),178,2)THEN 740
   : IF STR(C6$(),181,2)<STR(D2$(),181,2)THEN 740
   : IF STR(C6$(),187,2)<STR(D2$(),187,2)THEN 740
   : IF STR(C6$(),190,2)<STR(D2$(),190,2)THEN 740
   : GOSUB '51(C)
   : STR(J2$(),VAL(T2$,2)+3,2)=D9$
0740 NEXT C
   : GOTO 1050
0790 B2$=" "
   : GOSUB 2515
   : PRINT HEX(06);AT(8,0,79);TAB(25);B2$
   : B2$=" "
   : J6=VAL(STR(C6$(),256))
   : IF J6>0THEN 870
   : GOSUB 2520
   : RETURN
0870 IF MOD(J6,6)=0THEN 910
   : GOSUB 2525
   : RETURN
0910 FOR C=1TO J6-5STEP 6
   : UNPACK(####)STR(C6$(),C,2)TO J4
   : ERRORGOTO 1000
0940 IF POS(C0$=STR(C6$(),C+2,1))=0THEN 1000
   : D6=D6+1
   : J2$(D6)=STR(C6$(),C,6)
   : GOTO 1020
1000 GOSUB 2525
   : C=999
1020 NEXT C
   : RETURN
1050 PRINT HEX(06);AT(8,0,);
   : FOR C=1TO D6
   : UNPACK(####)J2$(C)TO J6
   : CONVERT J6TO D9$,(####)
   : STR(D9$,5,1)=STR(J2$(C),3,1)
   : GOSUB 2530
   : PRINT HEX(06);AT(8,17);B2$;" ";STR(D9$,1,5)
   : C3$=STR(J2$(C),4,2)
   : C4$=STR(J2$(C),1,3)
   : J2=0
1160 $TRAN(STR(C3$,2,1),D7$)R
   : J=VAL(C3$)*16+VAL(STR(C3$,2))
   : DATA LOAD BA T#6,(D1+J)C6$()
   : ERRORGOTO 1630
1210 J2=J2+1
   : IF STR(C6$(),5,3)<>C4$THEN 1630
   : ON SGN(J2-2)+2GOTO 1270,1450,1500
1270 IF C6$(3)<>HEX(FF)OR C6$(4)<>"A"THEN 1630
   : J3=VAL(C6$(255))*256+VAL(C6$(254))
   : STR(J2$(C),6,1)=HEX(00)
   : IF POS(STR(C6$(),245,6)>00)=0THEN 1430
   : J5=0
   : FOR J4=245TO 250
   : IF C6$(J4)<HEX(30)THEN J5=1
   : IF C6$(J4)>HEX(39)AND C6$(C)<HEX(41)THEN J5=1
   : IF C6$(J4)>HEX(5A)AND C6$(C)<HEX(61)THEN J5=1
   : IF C6$(C)>HEX(71)THEN J5=1
   : NEXT J4
   : IF J5=0THEN STR(J2$(C),6,1)=HEX(20)
1430 GOTO 1550
1450 J6=VAL(C6$(3))
   : IF J6<1OR J6>120THEN 1630
   : IF C6$(4)<>HEX(00)THEN 1630
   : GOTO 1550
1500 J6=VAL(C6$(3))
   : IF J6<7THEN 1630
   : GOTO 1550
1550 C3$=C6$(1)&C6$(2)
   : IF C3$<>HEX(0000)THEN 1160
   : IF J2<J3THEN 1630
   : STR(J2$(C),6,1)=HEX(00)
   : GOSUB 2535
   : PRINT HEX(06);AT(10,19);B2$
   : GOTO 1650
1630 OR (STR(J2$(C),6,1),80)
   : GOSUB 2540
   : PRINT HEX(06);AT(10,19);B2$
1650 NEXT C
   : GOSUB 2545
   : PRINT HEX(06);AT(8,0,);TAB(29);B2$
   : J4=D6*6
   : STR(J2$(),J4+1)=ALL(FF)
   : MAT SORTJ2$()TO D5$(),D4$()
   : J$()=ALL(00)
   : MAT MOVE J2$(),D4$()TO J$()
   : J2$()=J$()
   : STR(J2$(),J4+1)=ALL(00)
   : D2$()=STR(J2$(),1,252)
   : STR(D2$(),253,3)=HEX(000000)
   : IF J4<252THEN 1840
   : J6=J4-252
   : J4=252
   : GOTO 1850
1840 J6=0
1850 D2$(256)=BIN(J4)
   : DATA SAVE BA T#6,(D1+12)D2$()
   : STR(D2$(),1,252)=STR(J2$(),253,252)
   : D2$(256)=BIN(J6)
   : DATA SAVE BA T#6,(D1+1)D2$()
   : GOSUB 2550
   : PRINT HEX(06);AT(8,0,);TAB(22);B2$
   : LOAD T"609RCVR3"
1930 DEFFN'50(D9$)
   : $TRAN(STR(D9$,2),D7$)R
   : J=VAL(D9$)*16+VAL(STR(D9$,2))
   : RETURN
1980 DEFFN'51(J6)
   : D9$=BIN(J6/16)
   : STR(D9$,2)=BIN(MOD(J6,16))
   : $TRAN(STR(D9$,2),D8$)R
   : RETURN
2500 % DO NOT RENUMBER THE FOLLOWING
2505 B2$="Rebuilding VTOC"
   : RETURN
2510 B2$="Found Admin Block for Document :"
   : RETURN
2515 B2$="Verifying Existing VTOC Entries"
   : RETURN
2520 B2$="Empty Vtoc"
   : RETURN
2525 B2$="Vtoc Damaged"
   : RETURN
2530 B2$="Attempting Test Retrieval of Document :"
   : RETURN
2535 B2$="Test Retrieval of Document : "&STR(D9$,1,5)&" Passed"
   : RETURN
2540 B2$="Test Retrieval of Document : "&STR(D9$,1,5)&" Failed"
   : RETURN
2545 B2$="All VTOC Entries Tested"
   : RETURN
2550 B2$="VTOC Rebuilt and Rewritten to Archive"
   : RETURN