image of READY prompt

Wang2200.org

Listing of file='DCOM030A' on disk='vmedia/701-2048D.wvd.zip'

# Sector 331, program filename = 'DCOM030A'
0010 REM DCOM030A,00-00(05/06/76),12003A - COPYRIGHT WANG LABS. INC., 1976
0370 DEFFNA(D)=256*VAL(A$(D))+VAL(STR(A$(D),2,1))
0380 DEFFNC(D)=256*VAL(C$(D))+VAL(STR(C$(D),2,1))
   : PRINT HEX(01);"MOUNT DISK PLATTERS AT INDICATED ADDRESSES";TAB(64)
   : GOSUB 3670
0420 GOSUB '91
   : IF N$=HEX(0000000000000000)THEN 1860
   : B2,I,O=1
   : O1=4
   : I9,O2=0
   : B1=2
   : LIMITS T#2,N$,X,Y,Z
   : DATA LOAD BA T#2,(X,X)I$()
   : AND (I$(1,1),F0)
   : IF I$(1,1)=HEX(40)THEN 570
0540 PRINT HEX(01);"FILE - ";N$;" - CAN NOT BE PROCESSED"
   : GOSUB 3670
   : GOTO 1850
0570 GOSUB '128(3,N$,3*Z)
   : IF R2$<>"0"THEN 540
   : LIMITS T#3,N$,X1,Y1,Z1
   : DATA SAVE BA T#3,(X1,X1)I$()
   : DATA LOAD BA T#2,(X,X)R9$()
   : GOSUB 1940
0670 IF I>N1THEN 1510
   : MAT COPY I$()<I,1>TO B$()<1,1>
   : IF B$(1)<>HEX(FF)THEN 1450
   : MAT COPY I$()<I-1,1>TO B$()<2,1>
   : IF B$(2)<>HEX(00)THEN 1450
   : L3=I-1
   : L4=O
   : IF O>250THEN 1620
   : MAT COPY I$()<I,3>TO O$()<O,3>
   : MAT COPY I$()<I+1,2>TO A$()
   : UNPACK(####)A$(1)TO C
0840 O=O+3
   : I=I+3
   : MAT SEARCHI$()<I,N1-I>,<>F$(3)TO A$()
   : I=I+FNA(1)-1
   : MAT COPY I$()<I,1>TO B$()<1,1>
   : O=O+1
   : IF B$(1)=HEX(A2)THEN 1010
   : IF B$(1)<>HEX(9D)THEN 980
   : IF O2=1THEN 980
   : O1=O1-2*SGN(O1-4)
0980 O=O+O1
1010 MAT SEARCHI$()<I,N1-I>,=F$(4)TO A$()
   : N=FNA(1)+2
   : MAT SEARCHI$()<I,N>,=F$(5)TO A$()
   : O3=0
   : IF A$(1)=HEX(0000)THEN 1290
   : I4=FNA(1)-1
   : MAT SEARCHI$()<I+I4,N1-I-I4>,<>F$(3)TO C$()
   : I4=FNC(1)+I4
1120 MAT SEARCHI$()<I,N1-I>,=STR(L$(1),1,2)TO C$()
   : IF C$(1)=HEX(0000)THEN 1180
   : I4=FNC(1)+1
   : MAT COPY I$()<I+I4,2>TO C$()
   : UNPACK(####)C$(1)TO C1
   : GOTO 1190
1180 C1=L1
1190 IF C>=C1-1THEN 1240
   : PACK(####)STR(L$(1),3,2)FROMC+1
   : GOTO 1270
1240 I9=1
   : O3=0
   : GOTO 1290
1270 O3=1
   : N=FNA(1)+2+I3
1290 IF O+N>255THEN 1610
   : IF B$(1)<>HEX(9E)THEN 1340
   : O1=O1+2
1340 O2=0
   : MAT COPY I$()<I,N>TO O$()<O,N>
   : IF O3=0THEN 1400
   : MAT COPY L$()<5,3>TO O$()<O+N-3,3>
   : I=I-5
   : MAT COPY L$()<1,4>TO I$()<I+N-1,4>
1400 I=I+N
   : O=O+N
   : GOTO 670
1450 IF B$(1)=HEX(FD)THEN 1510
   : MAT COPY I$()<I,1>TO O$()<O,1>
1490 I=I+1
   : IF I<257THEN 1560
1510 GOSUB 1940
   : I=2
   : GOTO 670
1560 O=O+1
   : IF B$(1)=HEX(FE)THEN 1700
   : IF O<257THEN 670
1610 O2=1
1620 O=L4
   : I=L3
   : MAT COPY F$()<1,1>TO O$()<O,1>
   : GOTO 1710
1700 O$(1,1)=HEX(20)
1710 GOSUB 3000
   : IF B$(1)=HEX(FE)THEN 1760
   : O$(1,1)=HEX(00)
   : O=1
   : GOTO 1490
1760 LIMITS T#3,N$,X2,Y2,Z2
   : DATA LOAD DC OPEN T#3,N$
   : DSKIP #3,B2S
   : DATA SAVE DC #3,END
   : GOSUB '127(3,N$,E1-1)
   : IF I9=0THEN 1850
   : PRINT HEX(01);"DECOMPRESSION WAS INCOMPLETE FOR FILE -";P-1;" NAME = ";N$
     ;TAB(64)
   : GOSUB 3670
   : I9=0
1850 GOTO 420
1860 DEFFN'15
   : PRINT HEX(03);"MOUNT ISS PLATTER"
   : GOSUB 3670
   : COM CLEAR P5
   : LOAD DC T#0,"START040"
1940 MAT COPY R9$()TO I$()
   : E=0
   : AND (I$(1,1),F0)
   : IF I$(1,1)<>HEX(20)THEN 2050
   : E=1
   : L1=10000
   : I$(1,1)=HEX(00)
2050 IF E=1THEN 2120
   : DATA LOAD BA T#2,(X,X)R9$()
   : B1=B1+1
   : MAT SEARCHI$(),=F$(1)TO A$()
   : GOTO 2130
2120 MAT SEARCHI$(),=F$(2)TO A$()
2130 N,N1=FNA(1)
   : F=1
2170 MAT SEARCHI$()<F,N-F+1>,=F$(8)TO A$()
   : IF A$(1)=HEX(0000)THEN 2250
   : G=FNA(1)-1
   : MAT COPY I$()<F+G-1,1>TO A$()
   : IF STR(A$(1),1,1)=HEX(00)THEN 2230
   : $TRAN(I$()<F+G,3>,F$)R
2230 F=F+G+1
   : GOTO 2170
2250 IF E=1THEN 2320
   : MAT COPY R9$()<3,2>TO A$()
   : UNPACK(####)A$(1)TO L1
2320 F=1
2330 MAT SEARCHI$()<F,N-F>,=F$(8)TO A$()
   : IF A$(1)=HEX(0000)THEN 2430
   : G=FNA(1)-1
   : MAT COPY I$()<F+G-1,1>TO A$()
   : IF STR(A$(1),1,1)=HEX(00)THEN 2390
   : $TRAN(I$()<F+G,3>,F$)R
2390 F=F+G+3
   : IF F<NTHEN 2330
2430 FOR F0=9TO 10
   : F=2
2450 MAT SEARCHI$()<F,N-F>,=F$(F0)TO A$()
   : IF A$(1)=HEX(0000)THEN 2530
   : G=FNA(1)-1
   : MAT SEARCHI$()<F+G,N-F-G>,<>F$(3)TO A$()
   : G=G+FNA(1)
   : $TRAN(I$()<F+G,1>,F$)R
   : F=F+G+1
   : IF F<NTHEN 2450
2530 NEXT F0
   : F=1
   : R2$=HEX(00FF)
2590 MAT SEARCHI$()<F,N-F>,=R2$TO A$()
   : IF A$(1)=HEX(0000)THEN 2760
   : F=F+FNA(1)
   : IF F>=NTHEN 2760
   : MAT SEARCHI$()<F,N-F>,=F$(4)TO A$()
   : H=FNA(1)+1
   : MAT SEARCHI$()<F+3,H-3>,<>F$(3)TO A$()
   : G=FNA(1)+2
   : MAT COPY I$()<F+G,1>TO A$()
2710 IF STR(A$(1),1,1)=HEX(A2)THEN 2740
   : IF STR(A$(1),1,1)<>HEX(D8)THEN 2780
2740 F=F+H
   : IF F<NTHEN 2590
2760 GOTO 3230
2780 G=F+G
2800 MAT SEARCHI$()<G,F+H-G>,=F$(7)TO C$()
   : H1=0
   : IF C$(1)=HEX(0000)THEN 2900
   : MAT SEARCHI$()<G,F+H-G>,=F$(6)TO A$()
   : IF A$(1)=HEX(0000)THEN 2930
   : IF A$(1)<C$(1)THEN 2900
   : H1=1
2900 MAT SEARCHI$()<G,F+H-G>,=F$(6+H1)TO C$()
   : IF C$(1)=HEX(0000)THEN 2740
2930 H2=G+FNC(1)-2
   : H3=G+FNC(2)-H2
   : IF H3<1THEN 3230
   : $TRAN(I$()<H2,H3>,F$)R
   : GOTO 2800
3000 IF X1<Y1-2THEN 3170
   : RETURN CLEAR
3030 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 540
3170 $TRAN(O$(),G$)R
   : DATA SAVE BA T#3,(X1,X1)O$()
   : B2=B2+1
   : INIT(20)O$()
3230 PRINT HEX(01);"DECOMPRESSING FILE NUMBER";P-1;TAB(40);"TOTAL BLOCKS =";Z-
     1;TAB(64)
   : PRINT "FILE NAME = ";N$;TAB(64),TAB(64)
   : PRINT "BLOCKS READ =";B1;TAB(40);"BLOCKS WRITTEN =";B2;TAB(64)
   : RETURN
3290 DEFFN'91
   : IF M$="ALL"THEN 3360
   : IF P>=P5THEN 3340
   : N$=N$(P)
   : GOTO 3370
3340 INIT(00)N$
   : RETURN
3360 GOSUB 3410
3370 P=P+1
   : RETURN
3410 GOSUB '129(2,N$)
   : N6=0
   : IF R6<>0THEN 3460
   : R=0
   : GOTO 3600
3460 IF R6=16THEN 3580
   : R6=R6+1
3480 FOR N4=R6TO 16
   : IF (N4-1)+ABS(R-1)=0THEN 3570
   : IF STR(R9$(N4),1,1)=HEX(21)THEN 3570
   : ON VAL(STR(R9$(N4),1,1))-15GOTO 3530,3570
   : GOTO 3560
3530 IF STR(R9$(N4),2,1)=HEX(00)THEN 3570
   : N$=STR(R9$(N4),9,8)
   : N6=1
3560 N4=16
3570 NEXT N4
3580 IF N6=1THEN 3640
   : IF R>=R4THEN 3630
3600 DATA LOAD BA T#2,(R,R)R9$()
   : R6=1
   : GOTO 3480
3630 INIT(00)N$
3640 RETURN
3670 KEYIN A$(1),3680,3680
3680 PRINT "KEY RETURN(EXEC) TO RESUME";TAB(64),TAB(64),TAB(64);HEX(0D0C0C)
3690 KEYIN A$(1),3690,3690
   : INPUT A$(1)
   : PRINT HEX(01);TAB(64),TAB(64),TAB(64),TAB(64)
   : RETURN
3740 DEFFN'127(R9,R9$,R1)
   : GOSUB '129(R9,R9$)
   : IF R6=0THEN 4130
   : R2$="0"
   : LIMITS T#R9,R9$,R2,R3,R0
   : IF R2+R0+R1-1>=R3THEN 4110
   : R2,R4=R2+R1+R0-1
   : DATA LOAD BA T#R9,(R3,R3)R9$()
   : R3$=HEX(FFFF)
   : ADDC(STR(R9$(1),2,2),R3$)
3910 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$()
4050 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$()
4110 RETURN
4130 R2$="1"
   : RETURN
4160 DEFFN'128(R9,R9$,R1)
   : GOSUB '129(R9,R9$)
   : IF R6<>0THEN 4420
   : 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)
4310 R3=VAL(STR(R9$(1),5,1))*256+VAL(STR(R9$(1),6,1))
   : IF R3-R2-1<R1+3THEN 4390
   : DATA SAVE DC OPEN T#R9,(R3-R2-1),R9$
   : RETURN
4390 R2$="1"
   : RETURN
4420 R2$="2"
   : RETURN
4450 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$)
4640 ADD(STR(R3$,1,1),STR(R3$,2,1))
   : R3=VAL(R3$)
   : R3=R3-INT(R3/R4)*R4
   : R5=R3
4720 DATA LOAD BA T#R9,(R3,R)R9$()
   : R6=0
   : FOR R7=1TO 16
   : IF R3<>0THEN 4840
   : IF R7<>1THEN 4840
   : R7=2
4840 R2$=STR(R9$(R7),1,1)
   : IF R2$=HEX(00)THEN 4960
   : IF R2$=HEX(10)THEN 4920
   : IF R2$<>HEX(11)THEN 4980
4920 IF STR(R9$(R7),9,8)<>R9$THEN 4980
   : R6=R7
4960 R7=16
4980 NEXT R7
   : IF R2$=HEX(00)THEN 5120
   : IF R6<>0THEN 5120
   : R3=R3-1
   : IF R3=R5THEN 5120
   : IF R3>=0THEN 4720
   : R3=R4-1
   : GOTO 4720
5120 RETURN