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)