Listing of file='DISKDUMP' on disk='vmedia/701-2048D.wvd.zip'
# Sector 265, program filename = 'DISKDUMP'
0010 REM DISKDUMP,00-00(02/18/76),12003A - COPYRIGHT WANG LABS. INC., 1976
0050 DIM R$(8)32,T$(8)32,T1$32,T2$32,S$32,R$1,Q$64,P$8,Q6$(1)64
: DIM R1$8,R2$1,R3$2,R9$8,R9$(16),I$(8)3
: I$(1)="310"
: I$(2)="320"
: I$(3)="330"
: I$(4)="350"
: I$(5)="B10"
: I$(6)="B20"
0130 I$(7)="B30"
: I$(8)="360"
: INIT(2E)T$(1)
: INIT(40)T$(5),T$(6),T$(7),T$(8)
: T$(2)=HEX(202122232425262728292A2B2C2D2E2F303132333435363738393A3B3C3D3E3
F)
0180 T$(3)=HEX(404142434445464748494A4B4C4D4E4F505152535455565758595A5B5C5D5E5
F)
: T$(4)=HEX(606162636465666768696A6B6C6D6E6F707172737475767778797A7B7C7D7E7
F)
: GOTO 3070
0210 RETURN
0240 GOSUB 2330
: SELECT PRINT 215(131)
: M=M+10
: GOSUB 2930
: PRINT " BYTES","RECORD -";O-1
: FOR I=0TO 7
: PRINTUSING 380,I*32,(I+1)*32-1;
0380 %### - ###
0400 FOR J=1TO 32STEP 4
: HEXPRINT STR(R$(I+1),J,4);
: PRINT " ";
: NEXT J
: $TRAN(R$()<I*32+1,32>,T$())
: PRINT TAB(90);R$(I+1)
: NEXT I
: PRINT " "
: GOTO 2760
0560 T1$=HEX(3000310132023303340435053606370738083909410A420B430C440D450E460F)
: T2$=HEX(300031103220333034403550366037703880399041A042B043C044D045E046F0)
: GOSUB 2330
: SELECT PRINT 215(80)
: M=M+20
: GOSUB 2930
0670 PRINT " BYTES","RECORD -";O-1
: FOR I=0TO 3
: MAT COPY R$()<I*64+1,64>TO Q6$()
: $TRAN(Q6$(),T$())
: PRINT TAB(14);Q6$(1)
: MAT COPY R$()<I*64+1,64>TO Q6$()
: $TRAN(Q6$(),T2$)F0R
: PRINTUSING 380,I*64,(I+1)*64-1;
: PRINT TAB(14);Q6$(1)
0850 MAT COPY R$()<I*64+1,64>TO Q6$()
: $TRAN(Q6$(),T1$)0FR
: PRINT TAB(14);Q6$(1)
: PRINT " "
: NEXT I
: PRINT " "
: GOTO 2760
0980 GOSUB 2330
: SELECT PRINT 215(80)
: IF INT(R)=2THEN 2760
: IF INT(R)=1THEN 2760
: IF R-INT(R)=.2THEN 1120
: SELECT PRINT 005(64),CO 005(64)
: PRINT "INVALID RECORD ENCOUNTERED"
: GOTO 2620
1120 I=0
: M=M+3
: GOSUB 2930
: PRINT HEX(0A),"PHYSICAL RECORD -";O-1
: IF STR(R$(1),1,1)=HEX(80)THEN 1300
: C=1
: AND (STR(R$(1),1,1),0F)
: IF STR(R$(1),1,1)<>HEX(01)THEN 1300
: C=0
1300 PRINT "LOGICAL RECORD -";E
: PRINT "PHYSICAL RECORD WITHIN LOGICAL RECORD -";VAL(STR(R$(1),2,1))
: K=1
: T=3
: PRINT " FIELD TYPE LENGTH VALUE"
1390 M=M+1
: GOSUB 2930
: IF M<>3THEN 1470
: PRINT " FIELD TYPE LENGTH VALUE"
1470 IF T<33THEN 1530
: K=K+1
: T=T-32
1530 I=I+1
: IF STR(R$(K),T,1)<>HEX(FD)THEN 1750
: PRINT "BYTES USED -";B
: M=M+1
: B=0
: IF C<>0THEN 2760
: PRINT "LOGICAL RECORD LENGTH -";L
: M=M+1
: L=0
: E=E+1
: GOTO 2760
1750 PRINT TAB(4);I;
: IF STR(R$(K),T,1)<HEX(80)THEN 2060
: PRINT TAB(14);"ALPHA";
: J=VAL(STR(R$(K),T,1))-127
: PRINT TAB(25);J-1;
: L=L+J
: B=B+J
: PRINT TAB(30);
: MAT COPY R$()<(K-1)*32+T+1,J-1>TO Q6$()
: $TRAN(Q6$(),T$())
: PRINT STR(Q6$(1),1,J-1)
: T=T+J
1990 IF T<=32THEN 1390
: T=T-32
: K=K+1
: GOTO 1390
2060 PRINT TAB(13);"NUMERIC 8";
: L=L+9
: B=B+9
: PRINT TAB(30);
: Q6$(1)=HEX(8100080000000000000000FD)
: MAT COPY R$()<(K-1)*32+T+1,8>TO Q6$()<4,8>
: T=T+9
: IF T<=32THEN 2260
: T=T-32
: K=K+1
2260 $UNPACKQ6$()TO Q2
: PRINT Q2
: GOTO 1390
2330 DATA LOAD BA T#1,(O,O)R$()
: F=F+1
: R$=HEX(E0)
: AND (R$,STR(R$(1),1,1))
: R=.1
: R2$="P"
: IF R$<HEX(80)THEN 2450
: R=.2
: R2$="D"
2450 AND (R$,70)
: R=R+VAL(R$)/32
: IF INT(R)<>1THEN 2490
: IF R2$<>"P"THEN 2800
2490 IF A>=FTHEN 2330
: IF F<=F2+1THEN 210
: GOSUB '248(0,0,4)
: PRINT "UPPER LIMIT REACHED"
: GOTO 2620
2570 S$=" "
: KEYIN S$,2590,2590
2590 IF STR(S$,1,1)="H"THEN 2620
: IF INT(R)=1THEN 2620
2610 ON ZGOTO 240,560,980
2620 SELECT PRINT 005(64),CO 005
: PRINT HEX(010A),"PROCESSING INTERRUPT KEY 1-CONTINUE 2-MODIFY 3-REUSE
4-END"
2640 KEYIN R$,2660,2870
: GOTO 2640
2660 GOSUB '248(0,0,4)
: IF R$="1"THEN 2570
: IF R$="2"THEN 3920
: IF R$="3"THEN 3070
: IF R$<>"4"THEN 2620
: SELECT PRINT 005(64),CO 005
: GOTO 2870
2760 IF INT(R)<>1THEN 2570
: IF R2$="D"THEN 2800
: R2$="D"
: GOTO 2800
2800 SELECT PRINT 005(64),CO 005
: PRINT HEX(01)," END OF FILE"
: GOTO 2620
2860 DEFFN'15
2870 SELECT PRINT 005(64),CO 005
: PRINT HEX(03)
: LOAD DC T#0,"START040"
2930 IF M<55THEN 210
: M=3
: PRINT HEX(0D0C)
: PRINT T$,,P$,,"PAGE";P1
: P1=P1+1
: RETURN
3020 M=100
: F=0
: E,P1=1
: GOTO 2610
3070 SELECT PRINT 005(64),CO 005(64)
: PRINT HEX(03)
: P$=Q1$
: GOSUB '248(4,10,1)
: PRINT "DATE - ";P$
: GOSUB '248(11,15,0)
: PRINT "**** ADDRESS TABLE ****"
: PRINT TAB(15);"1 - 310",TAB(34);"5 - B10"
: PRINT TAB(15);"2 - 320",TAB(34);"6 - B20"
3190 PRINT TAB(15);"3 - 330",TAB(34);"7 - B30"
: PRINT TAB(15);"4 - 350",TAB(34);"8 - 360";HEX(01)
: GOSUB '245("ENTER DISK UNIT NUMBER, SEE TABLE BELOW",1,0,1,6)
: ON Q-1GOTO 3290,3320,3350,3380,3410,3440,3470
: SELECT #1310
: GOTO 3490
3290 SELECT #1320
: GOTO 3490
3320 SELECT #1330
: GOTO 3490
3350 SELECT #1350
: GOTO 3490
3380 SELECT #1B10
: GOTO 3490
3410 SELECT #1B20
: GOTO 3490
3440 SELECT #1B30
: GOTO 3490
3470 SELECT #1360
3490 GOSUB '248(11,0,5)
: GOSUB '248(7,10,1)
: PRINT "INPUT DISK DEVICE ADDRESS - UNIT ";I$(Q)
: GOSUB '248(1,0,3)
: PRINT "MOUNT DISK - UNIT ";I$(Q)
: GOSUB 4320
3580 GOSUB '243("ENTER THE NAME OF THE FILE TO BE DUMPED",8)
: T$=Q$
: GOSUB '248(6,10,1)
: PRINT "FILE - ";T$
: GOSUB '229(1,T$)
: IF R6=0THEN 3710
: IF R2$<>HEX(11)THEN 3740
3710 GOSUB 4820
: GOTO 3580
3740 LIMITS T#1,T$,O,T,T
: P5=O
: GOSUB '248(8,10,1)
: PRINT "OUTPUT DEVICE - HIGH SPEED PRINTER"
: GOSUB '248(1,0,3)
3820 PRINT "READY PRINTER"
: GOSUB 4320
: SELECT PRINT 215
: PRINT HEX(00);
: $IF ON /215,3920
: GOSUB '248(1,0,3)
: PRINT HEX(0A0A),"PRINTER IS NOT READY"
: GOSUB '248(1,0,2)
: GOTO 3820
3920 GOSUB '248(1,0,3)
: GOSUB '243("DUMP PHYSICAL RECORDS WITHIN FILE (FFFF*LLLL OR ALL)",9)
: A=0
: O=P5
: F2=9E99
: S$=Q$
: IF STR(Q$,1,3)="ALL"THEN 4050
: I=POS(Q$="*")
: CONVERT STR(Q$,1,I-1)TO A
: CONVERT STR(Q$,I+1,POS(Q$=" ")-1)TO F2
4050 GOSUB '248(9,10,1)
: PRINT "PHYSICAL RECORDS WITHIN FILE TO BE DUMPED - ";S$
: GOSUB '248(11,15,0)
: PRINT "**** DUMPS AVAILABLE ****"
: PRINT ,"1 - HORIZONTAL"
: PRINT ,"2 - VERTICAL"
4120 PRINT ,"3 - DATA FILE STRUCTURE"
: GOSUB '245("ENTER TYPE OF DUMP, SEE TABLE BELOW",1,0,1,3)
: Z=Q
: GOSUB '248(5,10,1)
: ON Q-1GOTO 4210,4230
: PRINT "DUMP - HORIZONTAL"
: GOTO 4240
4210 PRINT "DUMP - VERTICAL"
: GOTO 4240
4230 PRINT "DUMP - DATA FILE STRUCTURE"
4240 GOSUB '248(11,0,4)
4250 GOSUB '243("PARAMETERS OKAY? (Y OR N)",1)
: IF Q$="Y"THEN 4300
: IF Q$="N"THEN 3070
: GOSUB 4820
: GOTO 4250
4300 GOSUB '248(0,0,4)
: GOTO 3020
4320 INPUT "KEY RETURN(EXEC) TO RESUME",Q$
: RETURN
4380 DEFFN'242(W,Q$)
: IF W<=0THEN 5130
: IF W=1THEN 4420
: STR(Q$,2)=STR(Q$,1,W-1)
4420 PRINT Q$;
: RETURN
4440 DEFFN'243(Q$,G)
: GOSUB 4850
4460 SELECT CO 205
: Q$=" "
: KEYIN Q$,4490,4490
4490 INPUT Q$
: IF Q$=" "THEN 4530
: IF G=0THEN 4920
: IF LEN(Q$)<=GTHEN 4920
4530 GOSUB 4820
: GOSUB 4900
: GOSUB 4870
: GOTO 4460
4570 DEFFN'245(Q$,U,V,W1,W2)
: G=ABS(U)+V+1
: GOSUB 4850
4600 GOSUB '242(ABS(U)+2,HEX(09))
: PRINT "/"
: GOSUB 4900
: SELECT CO 205
: Q,W=-1E-99
: KEYIN Q$,4660,4660
4660 INPUT Q
: IF W=QTHEN 4720
: IF W1>QTHEN 4720
: IF W2<QTHEN 4720
: IF Q>=0THEN 4770
: IF U<=0THEN 4770
4720 GOSUB 4820
: G=ABS(U)+V+1
: GOSUB 4900
: GOSUB 4870
: GOTO 4600
4770 IF ABS(Q)>=10^ABS(U)THEN 4720
: W=ABS(Q*10^V)
: IF INT(W)<>WTHEN 4720
4800 D=3
: GOTO 4970
4820 GOSUB 4800
: PRINT "RE-ENTER"
: RETURN
4850 GOSUB 5130
: PRINT HEX(010A);STR(Q$,1);
4870 GOSUB 5130
: GOSUB '242(G+2,"-")
: PRINT TAB(64)
4900 PRINT HEX(010A0A)
: RETURN
4920 PRINT HEX(0A);TAB(64)
: GOTO 5130
4960 D=0
4970 X=0
: Y=1
4990 DEFFN'248(D,X,Y)
: GOSUB 5130
: IF Y<1THEN 5100
: GOSUB 5100
: SELECT PRINT 205
: Q$=" "
: PRINT STR(Q$,X+1)
: IF Y<2THEN 5100
: FOR W=2TO Y
: PRINT HEX(0A);STR(Q$,1)
: NEXT W
5100 PRINT HEX(01)
: PRINT TAB(X);
: GOSUB '242(D,HEX(0A))
5130 SELECT PRINT 005(64),CO 005
: RETURN
5170 DEFFN'229(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$)
5360 ADD(STR(R3$,1,1),STR(R3$,2,1))
: R3=VAL(R3$)
: R3=R3-INT(R3/R4)*R4
: R5=R3
5440 DATA LOAD BA T#R9,(R3,R)R9$()
: R6=0
: FOR R7=1TO 16
: IF R3<>0THEN 5560
: IF R7<>1THEN 5560
: R7=2
5560 R2$=STR(R9$(R7),1,1)
: IF R2$=HEX(00)THEN 5680
: IF R2$=HEX(10)THEN 5640
: IF R2$<>HEX(11)THEN 5700
5640 IF STR(R9$(R7),9,8)<>R9$THEN 5700
: R6=R7
5680 R7=16
5700 NEXT R7
: IF R2$=HEX(00)THEN 5840
: IF R6<>0THEN 5840
: R3=R3-1
: IF R3=R5THEN 5840
: IF R3>=0THEN 5440
: R3=R4-1
: GOTO 5440
5840 RETURN