image of READY prompt

Wang2200.org

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

# Sector sector 840, 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