Listing of file='609FG080' on disk='vmedia/731-0067F-disk2.wvd.zip'
# Sector 306, program filename = '609FG080' 2000 REM '609FG080' - ARCHIVE I/O ROUTINES 2002 DEFFN'40 : GOSUB '46(0) : D4$=STR(D2$(),4,5) : D(4)=0 : INIT(00)D0$() : FOR C=3TO 4 : GOSUB '46(C) : D(4)=D(4)+VAL(D2$(256)) : STR(D0$(),1+(C-3)*252,252)=STR(D2$(),1,252) : IF D2$(256)<HEX(FC)THEN C=4 : NEXT C : RETURN 2022 DEFFN'43(D(11)) 2023 $OPEN 2025,#W0 : RETURN 2025 $BREAK255 : GOTO 2023 2027 RETURN 2029 DEFFN'45(C0$) : D(12)=0 : GOSUB '54(C0$) : IF D(4)=0THEN 2053 : MAT SEARCHSTR(D0$(),1,D(4)),=STR(D1$,1,3)TO D1$()STEP 6 : D(12)=VAL(D1$(1),2) : IF D(12)=0THEN 2053 : D$=D1$ : STR(D$,5,1)=STR(D0$(),D(12)+4,1) : STR(D$,32,2)=STR(D0$(),D(12)+3,2) : STR(D$,6,1)=STR(D0$(),D(12)+5,1) : IF STR(D$,6,1)>HEX(20)THEN 2053 2048 GOSUB '47(STR(D0$(),D(12)+3,2)) : $TRAN(D2$(),J1$()) : STR(D$,34,6)=STR(D2$(),245,6) : STR(D$,7,25)=STR(D2$(),14,25) 2053 RETURN 2055 DEFFN'46(D(11)) : D2$=BIN(D(11)) : $TRAN(D2$,D7$)R : DATA LOAD BA T#D(9),(VAL(D2$)+D1)D2$() : ERRORD(20)=ERR : GOTO 2060 2059 D(20)=0 2060 RETURN 2062 DEFFN'47(J9$) : $TRAN(STR(J9$,2,1),D7$)R : D(1)=VAL(STR(J9$,1,1))*16+VAL(STR(J9$,2,1)) : DATA LOAD BA T#D(9),(D(1)+D1)D2$() : ERRORD(20)=ERR : GOTO 2067 2066 IF STR(D2$(),5,3)<>D1$THEN D(20)=1 : ELSE D(20)=0 2067 RETURN 2069 DEFFN'48(D2$(),D(11)) : D2$=BIN(D(11)) : $TRAN(D2$,D7$)R : DATA SAVE BA T#D(9),(VAL(D2$)+D1)D2$() : ERRORD(20)=ERR : GOTO 2074 2073 D(20)=0 2074 RETURN 2076 DEFFN'49(D(11)) : D(10)=INT(D(11)/16) : D2$=BIN(D(11)-(D(10)*16)) : $TRAN(D2$,J8$)R : J9$=BIN(D(10))&D2$ : RETURN 2083 DEFFN'54(J9$) : D1$=" " : CONVERT STR(J9$,1,4)TO S7 : ERRORGOTO 2088 2086 PACK(####)D1$FROMS7 : STR(D1$,3,1)=STR(J9$,5,1) 2088 RETURN 2090 DEFFN'56(D(21)) : D(23)=-1 : IF D(21)>0THEN 2119 : D(10)=POS(STR(D8$(),1,153)<FF) : IF D(10)=0THEN 2116 : FOR C=1TO 8 : J$=D8$(D(10))AND D7$(C) : IF J$<>D8$(D(10))THEN 2115 : D(23)=(D(10)-1)*8+C-1 : C$=BIN(MOD(D(23),16)) : $TRAN(C$,D7$)R : D(23)=INT(D(23)/16)*16+VAL(C$) : OR (D8$(D(10)),D6$(C)) : C=8 2115 NEXT C 2116 RETURN 2119 IF MOD(D(21),8)<>0THEN D(21)=D(21)+8-MOD(D(21),8) : GOSUB '43(D(9)) : GOSUB '46(2) : STR(D2$(),1,2)=HEX(FFFF) : INIT(00)D8$() : D(10)=0 2130 IF D(21)=0THEN 2138 : D(10)=D(10)+1 : IF D(10)>153THEN 2143 : IF D2$(D(10))<>HEX(00)THEN 2130 : D2$(D(10)),D8$(D(10))=HEX(FF) : D(21)=D(21)-8 : GOTO 2130 2138 D(23)=0 : XOR (D8$(),FF) : GOSUB '48(D2$(),2) 2143 $CLOSE#V1 : RETURN 2146 DEFFN'57(D(22)) : IF D(22)>-1THEN 2168 : GOSUB '43(D(9)) : GOSUB '46(2) : XOR (D9$(),FF) : AND (D2$(),D9$()) : STR(D2$(),1,2)=HEX(FFFF) : GOSUB '48(D2$(),2) : $CLOSE#V1 : RETURN 2168 GOSUB '49(D(22)) : D(22)=VAL(J9$)*16+VAL(STR(J9$,2)) : D9$(INT(D(22)/8)+1)=HEX(FF) : RETURN 2174 DEFFN'58(A3$,D(19)) : D(22)=0 : GOSUB '43(D(9)) : GOSUB '40 : IF D(4)<504THEN 2184 : D(22)=-1 : GOTO 2194 2184 GOSUB '54(A3$) : GOSUB '49(D(19)) : STR(D0$(),D(4)+1,6)=STR(D1$,1,3)&STR(J9$,1,2)&HEX(00) : D(4)=D(4)+6 : GOSUB 2230 2194 $CLOSE#V1 : RETURN 2197 DEFFN'52(A3$,J3$,J$) : GOSUB '43(D(9)) : GOSUB '40 : GOSUB '45(A3$) : IF J3$<>HEX(FFFF)THEN STR(D0$(),D(12)+3,2)=J3$ : IF J$<>HEX(FF)THEN STR(D0$(),D(12)+5,1)=J$ : GOSUB 2237 : $CLOSE#V1 : RETURN 2213 DEFFN'59(A3$) : GOSUB '43(D(9)) : GOSUB '40 : GOSUB '45(A3$) : STR(D0$(),D(12))=STR(D0$(),D(12)+6)&ALL(00) : D(4)=D(4)-6 : GOSUB 2237 : $CLOSE#V1 : RETURN 2230 IF D(4)<504THEN STR(D0$(),D(4)+1)=ALL(FF) : MAT SORTD0$()TO D5$(),D4$() : J$()=ALL(00) : MAT MOVE D0$(),D4$()TO J$() : D0$()=J$() : IF D(4)<504THEN STR(D0$(),D(4)+1)=ALL(00) 2237 D2$()=STR(D0$(),1,252) : STR(D2$(),253,3)=HEX(000000) : IF D(4)<252THEN 2243 : C1=D(4)-252 : D(4)=252 : GOTO 2244 2243 C1=0 2244 D2$(256)=BIN(D(4)) : GOSUB '48(D2$(),3) : STR(D2$(),1,252)=STR(D0$(),253,252) : D2$(256)=BIN(C1) : GOSUB '48(D2$(),4) : RETURN