Listing of file='COMP010B' on disk='vmedia/701-2048D.wvd.zip'
# Sector 470, program filename = 'COMP010B'
0010 REM COMP010B,00-00(02/18/76),12003A - COPYRIGHT WANG LABS. INC., 1976
0540 DIM P$(25)50,R1$8,R2$1,R3$2,R9$8,R9$(16),W$(1)2,O$(16)
: DIM C$(1,255)1,M$(8)1,N$8
: DIM B$(255)2,O1$(16),T$10,T1$4,T2$10,A$(1)3,T$(10)1
: GOTO 2680
0600 LIMITS T#2,N$,X,Y,Z
: LIMITS T#3,N$,X1,Y1,Z1
: DATA LOAD BA T#2,(X,X)O1$()
: B1,B2=1
: PRINT HEX(01);"COMPRESSING FILE";P-1;TAB(40);"TOTAL BLOCKS =";Z-1;TAB(64)
: PRINT "FILE NAME = ";N$,TAB(64)
: DATA SAVE BA T#3,(X1,X1)O1$()
: INIT(00)O1$()
0700 O2=1
: GOSUB 4510
: GOSUB 1980
: MAT SEARCHR9$(),=T$(4)TO W$()
: T=VAL(W$(1))*256+VAL(STR(W$(1),2,1))+3
: O=T-3
: MAT COPY R9$()<1,T>TO O$()<1,T>
: MAT COPY T$()<1,1>TO O$()<O+3,1>
: A=1
: FOR J=2TO Z-1
: IF J=2THEN 930
: GOSUB 4510
: GOSUB 1980
: T=2
0930 IF N<5THEN 1760
: IF N-T-4<=0THEN 1760
0960 MAT SEARCHR9$()<T+3,N-T-4>,<>T$(3)TO W$()
: T1=VAL(STR(W$(1),2,1))+2
: MAT COPY R9$()<T+T1,1>TO W$()
: IF STR(W$(1),1,1)<>HEX(A2)THEN 1070
: MAT SEARCHR9$()<T,N-T-1>,=T$(4)TO W$()
: T1=VAL(STR(W$(1),2,1))+2
: GOTO 1730
1070 MAT COPY R9$()<T+1,2>TO W$()
: INIT(20)C$()
: IF A=1THEN 1190
: UNPACK(####)W$(1)TO L
: B=INT(L/8)
: B0=L-B*8+1
: W$(1)=STR(P$(INT(B/50)+1),B-INT(B/50)*50+1,1)
: AND (STR(W$(1),1,1),M$(B0))
: IF STR(W$(1),1,1)=HEX(00)THEN 1300
1190 GOSUB 4080
: $TRAN(R9$()<T,3>,T$)R
: MAT COPY R9$()<T,3>TO C$()<1,3>
: C=4
: O=O+3
: A=0
: GOTO 1340
1300 MAT COPY T$()<5,1>TO C$()<1,1>
: C=2
1340 MAT SEARCHR9$()<T,N-T-1>,=T$(4)TO B$()
: T1=VAL(STR(B$(1),2,1))-1
: MAT COPY R9$()<T+3,T1>TO C$()<C,T1>
: MAT SEARCHC$(),<>T$(3)TO B$()
: R3$=HEX(0000)
: MAT SEARCHB$(),=R3$TO W$()
: D=INT((VAL(W$(1))*256+VAL(STR(W$(1),2,1)))/2)
1450 IF D<=P9THEN 1490
: PRINT HEX(010A0A0A);"SOURCE STATEMENT LINE >";P9
: GOTO 4150
1490 $TRAN(B$(),T1$)R
: MAT MOVE C$(),B$(1),DTO C$(1,1)
: W$(1)=HEX(3AA2)
: MAT SEARCHC$(),=W$(1)TO W$()
: IF W$(1)=HEX(0000)THEN 1590
: T0=VAL(W$(1))*256+VAL(STR(W$(1),2,1))
: MAT COPY A$()TO C$()<T0,3>
: D=T0+2
1590 IF O+D-2<=P9THEN 1670
: GOSUB 4080
: MAT COPY T$()<1,1>TO O$()<2,1>
: O=-1
: A=1
: GOTO 930
1670 MAT COPY C$()<1,D>TO O$()<O,D>
: MAT COPY T$()<1,1>TO O$()<O+D,1>
: T1=T1+3
: O=O+D-3
1730 T=T+T1
: IF T<NTHEN 960
1760 NEXT J
: GOSUB 4080
: MAT COPY T$()<3,1>TO O1$()<1,1>
: MAT COPY T$()<2,1>TO O1$()<O2+1,1>
: $TRAN(O1$(),T2$)R
: DATA SAVE BA T#3,(X1,X1)O1$()
: B2=B2+1
: DATA LOAD DC OPEN T#3,N$
: DSKIP #3,B2S
: DATA SAVE DC #3,END
: GOSUB '127(3,N$,1)
: RETURN
1980 T=1
1990 MAT SEARCHR9$()<T,N-T>,=T$(8)TO W$()
: IF W$(1)=HEX(0000)THEN 2090
: T1=VAL(STR(W$(1),2,1))-1
: MAT COPY R9$()<T+T1-1,1>TO W$()
: IF STR(W$(1),1,1)=HEX(00)THEN 2050
: $TRAN(R9$()<T+T1,3>,T$)R
2050 T=T+T1+3
: IF T<NTHEN 1990
2090 FOR T0=9TO 10
: T=2
2110 MAT SEARCHR9$()<T,N-T>,=T$(T0)TO W$()
: IF W$(1)=HEX(0000)THEN 2190
: T1=VAL(STR(W$(1),2,1))-1
: MAT SEARCHR9$()<T+T1,N-T-T1>,<>T$(3)TO W$()
: T1=T1+VAL(STR(W$(1),2,1))
: $TRAN(R9$()<T+T1,1>,T$)R
: T=T+T1+1
: IF T<NTHEN 2110
2190 NEXT T0
: T=1
: R2$=HEX(00FF)
2250 MAT SEARCHR9$()<T,N-T>,=R2$TO W$()
: IF W$(1)=HEX(0000)THEN 2430
: T=T+VAL(STR(W$(1),2,1))
: IF T>=NTHEN 2430
: MAT SEARCHR9$()<T,N-T>,=T$(4)TO W$()
: T2=VAL(STR(W$(1),2,1))+1
: MAT SEARCHR9$()<T+3,T2-3>,<>T$(3)TO W$()
2340 T1=VAL(STR(W$(1),2,1))+2
: MAT COPY R9$()<T+T1,1>TO W$()
: IF STR(W$(1),1,1)=HEX(A2)THEN 2410
: IF STR(W$(1),1,1)<>HEX(D8)THEN 2450
: $TRAN(R9$()<T+T1,T2-T1>,T$)R
2410 T=T+T2
: IF T<NTHEN 2250
2430 RETURN
2450 T1=T+T1
2470 MAT SEARCHR9$()<T1,T+T2-T1>,=T$(7)TO B$()
: T5=0
: IF B$(1)=HEX(0000)THEN 2570
: MAT SEARCHR9$()<T1,T+T2-T1>,=T$(6)TO W$()
: IF W$(1)=HEX(0000)THEN 2600
: IF W$(1)<B$(1)THEN 2570
: T5=1
2570 MAT SEARCHR9$()<T1,T+T2-T1>,=T$(6+T5)TO B$()
: IF B$(1)=HEX(0000)THEN 2410
2600 T6=T1+VAL(STR(B$(1),2,1))-1
: T7=T1+VAL(STR(B$(2),2,1))-T6
: IF T7<1THEN 2410
: $TRAN(R9$()<T6,T7>,T$)R
: GOTO 2470
2680 FOR I=0TO 7
: BIN(M$(8-I))=2^I
: NEXT I
: T$=HEX(F020F122F227F33A2020)
: T1$=HEX(01002020)
: T2$=HEX(20F022F127F23AF32020)
: T$(1)=HEX(FD)
: T$(2)=HEX(FE)
: T$(3)=HEX(20)
: T$(4)=HEX(0D)
: T$(5)=HEX(3A)
: T$(6)=HEX(22)
: T$(7)=HEX(27)
2850 T$(8)=HEX(FF)
: T$(9)=HEX(9A)
: T$(10)=HEX(CE)
: A$(1)=HEX(0D0000)
: INIT(00)N$
: PRINT HEX(01);TAB(64)
: PRINT "MOUNT DISK PLATTERS";TAB(64)
: GOSUB 4710
: P=1
2940 GOSUB '91
: IF N$=HEX(0000000000000000)THEN 3990
: INIT(00)P$()
: B1,B2=1
: LIMITS T#2,N$,X,Y,Z
: GOSUB '129(3,N$)
: IF R2$<>HEX(00)THEN 3090
: DATA LOAD BA T#2,(X,X)O$()
: AND (STR(O$(1),1,1),F0)
: IF STR(O$(1),1,1)=HEX(40)THEN 3120
3090 PRINT HEX(010A);"FILE - ";N$;" - CAN NOT BE PROCESSED";TAB(64)
: GOSUB 4710
: GOTO 3570
3120 GOSUB '128(3,N$,Z+1)
: IF R2$<>"0"THEN 3090
: A=0
: PRINT HEX(01);"BUILDING PROTECT TABLE FOR FILE";P-1;TAB(40);"TOTAL BLOCKS
=";Z-1;TAB(64)
: PRINT "FILE NAME = ";N$,TAB(64),TAB(64),TAB(64)
: FOR J=1TO Z-2
: T=1
: GOSUB 4510
3220 MAT SEARCHR9$()<T,N+1-T>,=T$(8)TO W$()
: IF W$(1)=HEX(0000)THEN 3550
: T=T+VAL(STR(W$(1),2,1))-1
: MAT COPY R9$()<T-1,1>TO W$()
: IF STR(W$(1),1,1)=HEX(00)THEN 3290
: T0=0
: GOTO 3480
3290 MAT SEARCHR9$()<T+3,N-2-T>,<>T$(3)TO W$()
: T0=VAL(STR(W$(1),2,1))
: MAT COPY R9$()<T+T0+2,2>TO W$()
: IF W$(1)=HEX(A20D)THEN 3440
: IF STR(W$(1),1,1)=HEX(A2)THEN 3530
: IF A=0THEN 3400
: T0=-2
: A=0
: GOTO 3480
3400 IF W$(1)=HEX(A20D)THEN 3440
: T1=VAL(W$(1))
: IF (T1-161)*(T1-216)*(T1-155)*(T1-156)<>0THEN 3460
3440 A=1
3460 IF (T1-216)*(T1-206)<>0THEN 3530
3480 MAT COPY R9$()<T+1,2>TO W$()
: UNPACK(####)W$(1)TO L
: B=INT(L/8)
: B0=L-B*8+1
: OR (STR(P$(INT(B/50)+1),B-INT(B/50)*50+1,1),M$(B0))
3530 T=T+T0+2
: IF T<NTHEN 3220
3550 NEXT J
: GOSUB 600
3570 GOTO 2940
3600 DEFFN'91
: IF M$="ALL"THEN 3670
: IF P>=P5THEN 3650
: N$=N$(P)
: GOTO 3680
3650 INIT(00)N$
: RETURN
3670 GOSUB 3720
3680 P=P+1
: RETURN
3720 GOSUB '129(2,N$)
: N6=0
: IF R6<>0THEN 3770
: R=0
: GOTO 3910
3770 IF R6=16THEN 3890
: R6=R6+1
3790 FOR N4=R6TO 16
: IF (N4-1)+ABS(R-1)=0THEN 3880
: IF STR(R9$(N4),1,1)=HEX(21)THEN 3880
: ON VAL(STR(R9$(N4),1,1))-15GOTO 3840,3880
: GOTO 3870
3840 IF STR(R9$(N4),2,1)=HEX(00)THEN 3880
: N$=STR(R9$(N4),9,8)
: N6=1
3870 N4=16
3880 NEXT N4
3890 IF N6=1THEN 3950
: IF R>=R4THEN 3940
3910 DATA LOAD BA T#2,(R,R)R9$()
: R6=1
: GOTO 3790
3940 INIT(00)N$
3950 RETURN
3990 DEFFN'15
: COM CLEAR P5
: PRINT HEX(030A);"MOUNT ISS PLATTER"
: GOSUB 4710
: COM CLEAR P5
: LOAD DC T#0,"START040"
4080 IF O+O2<253THEN 4420
: IF X1<Y1-2THEN 4330
: RETURN CLEAR
4150 RETURN CLEAR
4170 GOSUB '129(3,N$)
: LIMITS T#3,N$,X1,Y1,Z1
: INIT(00)R9$(R6)
: DATA SAVE BA T#3,(R3,R)R9$()
: DATA LOAD BA T#3,(0,R)R9$()
: BIN(STR(R9$(1),3,1))=INT(X1/256)
: BIN(STR(R9$(1),4,1))=X1-INT(X1/256)*256
: DATA SAVE BA T#3,(0,R)R9$()
: GOTO 3090
4330 $TRAN(O1$(),T2$)R
: DATA SAVE BA T#3,(X1,X1)O1$()
: B2=B2+1
: INIT(00)O1$()
: O2=1
: A=1
: PRINT HEX(010A0A0A);"BLOCKS READ =";B1;TAB(40);"BLOCKS WRITTEN =";B2
4420 MAT COPY O$()<2,O+3>TO O1$()<O2+1,O+3>
: O2=O2+O+1
: O=-1
: INIT(00)O$()
: INIT(20)C$()
: RETURN
4510 DATA LOAD BA T#2,(X,X)R9$()
: N=0
: AND (STR(R9$(1),1,1),F0)
: IF STR(R9$(1),1,1)<>HEX(20)THEN 4590
: N=1
: STR(R9$(1),1,1)=HEX(00)
4590 B1=B1+1
: PRINT HEX(010A0A0A);"BLOCKS READ =";B1;TAB(40)
: IF N=1THEN 4660
: MAT SEARCHR9$(),=T$(1)TO B$()
: GOTO 4670
4660 MAT SEARCHR9$(),=T$(2)TO B$()
4670 N=VAL(B$(1))*256+VAL(STR(B$(1),2,1))
: RETURN
4710 KEYIN B$(1),4710,4710
: PRINT TAB(63);HEX(0D)
: INPUT "KEY RETURN(EXEC) TO RESUME",B$(1)
: RETURN
4760 DEFFN'127(R9,R9$,R1)
: GOSUB '129(R9,R9$)
: IF R6=0THEN 5150
: R2$="0"
: LIMITS T#R9,R9$,R2,R3,R0
: IF R2+R0+R1-1>=R3THEN 5130
: R2,R4=R2+R1+R0-1
: DATA LOAD BA T#R9,(R3,R3)R9$()
: R3$=HEX(FFFF)
: ADDC(STR(R9$(1),2,2),R3$)
4930 STR(R9$(1),1,1)=HEX(20)
: DATA SAVE BA T#R9,(R4,R3)R9$()
: GOSUB '129(R9,R9$)
: R4=R2
: BIN(STR(R9$(R6),5,1))=INT(R4/256)
: BIN(STR(R9$(R6),6,1))=R4-INT(R4/256)*256
: STR(R9$(R6),2,1)=HEX(80)
: DATA SAVE BA T#R9,(R3,R3)R9$()
5070 DATA LOAD BA T#R9,(0,R3)R9$()
: BIN(STR(R9$(1),3,1))=INT((R4+1)/256)
: BIN(STR(R9$(1),4,1))=R4+1-INT((R4+1)/256)*256
: DATA SAVE BA T#R9,(0,R3)R9$()
5130 RETURN
5150 R2$="1"
: RETURN
5180 DEFFN'128(R9,R9$,R1)
: GOSUB '129(R9,R9$)
: IF R6<>0THEN 5440
: R2$="0"
: DATA LOAD BA T#R9,(0,R3)R9$()
: AND (STR(R9$(1),3,1),7F)
: R2=VAL(STR(R9$(1),3,1))*256+VAL(STR(R9$(1),4,1))
: AND (STR(R9$(1),5,1),7F)
5330 R3=VAL(STR(R9$(1),5,1))*256+VAL(STR(R9$(1),6,1))
: IF R3-R2-1<R1+3THEN 5410
: DATA SAVE DC OPEN T#R9,(R3-R2-1),R9$
: RETURN
5410 R2$="1"
: RETURN
5440 R2$="2"
: RETURN
5470 DEFFN'129(R9,R9$)
: DATA LOAD BA T#R9,(0,R3)R9$()
: AND (STR(R9$(1),2,1),7F)
: R4=VAL(STR(R9$(1),2,1))
: R1$=R9$
: XOR (STR(R1$,2),R1$)
: R2$=STR(R1$,8,1)
: R3$=HEX(0000)
: ADDC(R3$,R2$)
: ADDC(R3$,R2$)
: ADDC(R3$,R2$)
5660 ADD(STR(R3$,1,1),STR(R3$,2,1))
: R3=VAL(R3$)
: R3=R3-INT(R3/R4)*R4
: R5=R3
5740 DATA LOAD BA T#R9,(R3,R)R9$()
: R6=0
: FOR R7=1TO 16
: IF R3<>0THEN 5860
: IF R7<>1THEN 5860
: R7=2
5860 R2$=STR(R9$(R7),1,1)
: IF R2$=HEX(00)THEN 5980
: IF R2$=HEX(10)THEN 5940
: IF R2$<>HEX(11)THEN 6000
5940 IF STR(R9$(R7),9,8)<>R9$THEN 6000
: R6=R7
5980 R7=16
6000 NEXT R7
: IF R2$=HEX(00)THEN 6140
: IF R6<>0THEN 6140
: R3=R3-1
: IF R3=R5THEN 6140
: IF R3>=0THEN 5740
: R3=R4-1
: GOTO 5740
6140 RETURN