image of READY prompt

Wang2200.org

Listing of file='LPIDSUBS' on disk='vmedia/701-2721C.wvd.zip'

# Sector 289, program filename = 'LPIDSUBS'
4080 REM %  READ NEXT PHYSICAL RECORD SUBROUTINE ('71)
4090 DEFFN'71
   : GOSUB '68(1)
   : $CLOSE#10
   : RETURN
4120 UNPACK(####)STR(B4$(D7),36,6)TO C3,C5,B2
   : C5=C5/2
   : B2=B2+SGN(C5-INT(C5))
   : C5=INT(C5)*2
   : B2=INT(B2/4)*4
   : RETURN
4130 DEFFN'85(D7)
   : GOSUB 4120
   : D4=C5
   : C8=1
   : B6=B2
4140 IF D4<1THEN 4150
   : B5=128
   : IF B5>D4THEN B5=D4
   : IF C8+B5<=C3THEN MAT COPY -K8$()<C8+B5/2,C3-C8-B5+1>TO -K8$()<C8+B5,C3-C8
     -B5+1>
   : B8$()=STR(K8$(),C8,B5)
   : MAT REDIM B8$(2)B5/2
   : B8$(2)=B8$(1)
   : ROTATE(B8$(2),4)
   : AND (B8$(),0F)
   : $TRAN(B8$(),E3$)R
   : STR(K8$(),C8,B5)=B8$()
   : MAT REDIM B8$(128)2
   : D4=D4-B5
   : C8=C8+B5
   : GOTO 4140
4150 IF B6<1THEN RETURN
   : B5=256
   : IF B5>B6THEN B5=B6
   : IF C8+B5<=C3THEN MAT COPY -K8$()<C8+B5*.75,C3-C8-B5+1>TO -K8$()<C8+B5,C3-
     C8-B5+1>
   : B8$()=STR(K8$(),C8,B5)
   : MAT REDIM B8$(4)B5/4,B7$(3)B5/4
4160 MAT COPY B8$()TO B7$()
   : B8$(4)=B8$(3)
   : AND (B8$(4),FC)
   : AND (B8$(1),3F)
   : AND (B8$(2),0F)
   : AND (B8$(3),03)
   : AND (B7$(1),C0)
   : ADD(B8$(2),B7$(1))
   : AND (B7$(2),F0)
   : ADD(B8$(3),B7$(2))
   : ROTATE(B8$(2),2)
   : ROTATE(B8$(3),4)
   : ROTATE(B8$(4),6)
   : ADD(B8$(),20)
   : STR(K8$(),C8,B5)=B8$()
   : MAT REDIM B8$(128)2,B7$(5)63
   : B6=B6-B5
   : C8=C8+B5
4170 GOTO 4150
4180 C6=1
   : FOR B2=0TO 2
   : GOSUB 4220
   : IF C3=0THEN 4200
   : IF B4=1THEN 4190
   : IF D7>0THEN STR(C4$(),C6)=STR(K8$(),ABS(C4),C3)
   : ELSE STR(C4$(),C6)=STR(D4$(),ABS(C4),C3)
4190 STR(C4$,C6,C3)=STR(C4$(1),C6)
   : IF C4<0THEN BOOL3(STR(C4$(1),C6),00)
   : C6=C6+C3
4200 NEXT B2
   : RETURN
4210 DEFFN'87(D7)
   : B4=2
   : C4$,C4$()=" "
   : GOTO 4180
4220 UNPACK(##)STR(B4$(ABS(D7)),19+B2)TO C3
   : IF C3=0THEN RETURN
   : UNPACK(####)STR(B4$(ABS(D7)),B2*2+22)TO C4
   : C4=C4-5000
   : RETURN
4230 UNPACK(##)STR(B4$(D7),12,6)TO B2,B5,B6,C3,C4,C5
   : UNPACK(####)STR(B4$(D7),28,4)TO C7,C8
   : RETURN
4250 B6$(1)=STR(B4$(ABS(D7)),11)
   : $GIO(73104400,B6$())
   : MAT REDIM B7$(5)64
   : RETURN
4260 DEFFN'89(D7,D3$(1),B7)
   : UNPACK(##)STR(B4$(D7),12)TO B2
4270 D5$=D3$()
   : C4=INT(VAL(STR(D5$,3))/32)
   : C5=VAL(STR(B4$(D7),9))+C4
   : ADDC(STR(D5$,1,2),STR(B4$(C5),44,2))
   : C3$()=D5$
   : B8=FNV(D7)
   : UNPACK(####)STR(B4$(C5),42)TO C7
   : B5=VAL(STR(D5$,3))-32*C4
   : B5=(B5*C7)/256
   : B8=B8+INT(B5)
   : B5=256*(B5-INT(B5))+1
   : D4=VAL(STR(B4$(C5),10))
   : ON B7GOTO 4250,4250,4250,4290
4280 IF STR(B4$(D7),11,1)=STR(B4$(C5),11,1)THEN 4300
4290 B6$(1)=STR(B4$(D7),11)
   : $GIO(73104400,B6$())
   : B6$(1)=STR(B4$(C5),11)
   : $GIO(73104480,B6$())
4300 DATA LOAD BA T#D4,(B8,C5)B8$()
   : C3$()=STR(B8$(),B5,1)
   : IF C3$()=" "THEN 4310
   : IF C3$()=C7$(8)THEN 4310
   : C7=-1
   : GOTO 4320
4310 C7=1
   : IF D5<=0THEN 4320
   : STR(B8$(),B5,1)=C7$(8)
   : DATA SAVE BA T#D4,(B8,C5)B8$()
4320 IF B7=0THEN B5$(D6+1)=C8$
   : GOTO 4250
4330 C8$=BIN(D7)&BIN((C6-1)/256)&BIN(C6-1-256*VAL(STR(C8$,2)))&BIN(FNV(D7))
   : D3$()=STR(C4$(),B5+1)
   : C4$=STR(C4$(1),1,B5)
   : GOTO 4260
4340 MAT SEARCHB4$(),=STR(C6$,1,8)TO C3$()STEP 1
   : D7=INT((FNV(D7)+44)/45)
   : IF D7>0THEN RETURN
   : C7=0
   : RETURN CLEAR
   : RETURN
4350 D6$=STR(B4$(D7),9)
   : MAT SEARCHB4$()<9,45*D6-8>,=D6$TO C3$()STEP 45
   : D7=INT((FNV(D7)+44)/45)
   : BIN(D6$)=D7
   : MAT SEARCHB4$()<9,45*D6-8>,>D6$TO C3$()STEP 45
   : D3=INT((FNV(D7)+44)/45)
   : D3=D3+(D6+1)*(1-SGN(D3))-1
   : UNPACK(##)STR(B4$(D7),13,1)TO C3
   : RETURN
4360 CONVERT C7TO B2$,(-####)
   : IF C7=0THEN 4400
   : B5=B5+1
   : C6=1
   : UNPACK(####)STR(B4$(VAL(STR(B4$(D7),9,1))),42,2)TO C3
4370 B4=257-B5
   : IF C3+1-C6<=B4THEN B4=C3+1-C6
   : MAT COPY B8$()<B5,B4>TO K8$()<C6,B4>
   : C6=C6+B4
   : B5=1
   : B8=B8+1
   : IF C6>C3THEN 4380
   : DATA LOAD BA T#D4,(B8,C5)B8$()
   : GOTO 4370
4380 GOSUB '85(D7)
   : GOSUB 4350
   : IF SGN(D5)<1THEN 4400
   : IF STR(B2$,1,1)="-"THEN 4400
   : FOR D7=D7TO D3
   : UNPACK(##)STR(B4$(D7),12)TO C7
   : IF C7>6THEN 4390
   : GOSUB '87(D7)
   : STR(C4$(),C6)=D3$()
   : B5$(D7)=C4$()
4390 NEXT D7
4400 CONVERT B2$TO C7
   : IF C7=0THEN RETURN
   : IF ABS(D5)<1THEN RETURN
   : D7=VAL(D6$)
   : GOSUB 4120
   : STR(D4$(),ABS(D5),C3)=K8$()
   : RETURN
4410 DEFFN'167(C6$,D5)
   : GOSUB 4340
4420 DEFFN'67(D7,D5)
   : B5$(D6+1)=BIN(D7)&STR(B4$(D7),44,2)&HEX(FF)
4430 DEFFN'68(D5)
   : D7=VAL(B5$(D6+1))
   : GOSUB 4230
   : C4=B5+3
   : D3$(),C3$()=STR(B5$(D6+1),2)
   : D4=VAL(STR(B4$(D7),10))
   : B6$(1)=STR(B4$(D7),11)
   : $GIO(73104480,B6$())
   : IF VAL(STR(D3$(),3))+C3+C3>256THEN 4450
   : BIN(D6$)=C3
   : ADD(STR(D3$(),1,3),D6$)
   : GOTO 4460
4450 ADDC(STR(D3$(),1,2),01)
   : STR(D3$(),3)=HEX(01)
4460 C3$()=D3$()
   : D3=FNV(D7)
   : C3$()=STR(B4$(D7),44)
   : B6=FNV(D7)+1
   : B4=INT((D3-B6)/C8)
   : C6=B4*C8+B6+C5
   : IF D3<=C6THEN 4480
4470 B4=B4+1
   : D3=B4*C8+B6
   : STR(D3$(),3)=HEX(01)
   : IF B4<C7THEN 4480
   : C7=0
   : RETURN
4480 DATA LOAD BA T#D4,(D3,C6)B8$()
   : INIT(00)C3$()
   : STR(C3$(),2)=STR(D3$(),3)
   : MAT COPY B8$()<FNV(D7),C3>TO C4$()
   : IF VAL(C4$())>253THEN 4470
   : B7=0
   : GOSUB 4330
   : GOTO 4360
4490 DEFFNV(D7)=VAL(C3$(),2)
9000 DEFFN'0"SCRATCH T ";HEX(22);"LPIDSUBS";HEX(22)
9010 DEFFN'1"SAVE T() ";HEX(22);"LPIDSUBS";HEX(22)