Listing of file='DCOM010A' on disk='vmedia/701-2048D.wvd.zip'
# Sector 302, program filename = 'DCOM010A'
0010 REM DCOM010A,00-00(02/18/76),12003A - COPYRIGHT WANG LABS. INC., 1976
0170 COM P5,N$(40)8,M$4,E1
: COM R1$8,R2$1,R3$2,R9$8,R9$(16),I$3,O$3
: DIM Q6$64,B$(1)2
: PRINT HEX(03)
: DATA LOAD DC OPEN T#0,"DCOMF010"
: DATA LOAD DC #0,M$,I$,O$,E1
: GOSUB 720
: GOSUB 830
: GOSUB 1540
0300 GOSUB '243("ARE THE PARAMETERS OK? Y/N",1)
: IF Q6$="Y"THEN 930
: IF Q6$="N"THEN 370
: GOSUB 2270
: GOTO 300
0370 F$="N"
: GOSUB '245("ENTER THE ITEM TO BE CHANGED. (0=END,5=SWITCH INPUT AND OUTP
UT)",1,0)
: IF Q9=0THEN 930
: IF Q9=5THEN 450
: IF Q9<5THEN 500
: GOSUB 2270
: GOTO 370
0450 Q6$=I$
: I$=O$
: O$=Q6$
: GOTO 510
0500 ON Q9GOSUB 540,620,700,810
0510 GOSUB 1540
: GOTO 370
0540 GOSUB '243("ENTER THE DESIRED OPTION. (ALL OR PART)",4)
: IF Q6$="ALL"THEN 590
: IF Q6$="PART"THEN 590
: GOSUB 2270
: GOTO 540
0590 M$=Q6$
: RETURN
0620 GOSUB '245("ENTER THE NUMBER OF EXTRA SECTORS FOR EACH FILE. (2-50)",2,0
)
: IF Q9<2THEN 650
: IF Q9<51THEN 670
0650 GOSUB 2270
: GOTO 620
0670 E1=Q9
: RETURN
0700 GOSUB '243("ENTER THE INPUT ADDRESS.",3)
: I$=Q6$
0720 IF I$=O$THEN 780
: IF STR(I$,1,1)="B"THEN 750
: IF STR(I$,1,1)<>"3"THEN 780
0750 GOSUB '97(I$)
: IF Q6$="N"THEN 780
: RETURN
0780 GOSUB 2270
: GOTO 700
0810 GOSUB '243("ENTER THE OUTPUT ADDRESS.",3)
: O$=Q6$
0830 IF I$=O$THEN 890
: IF STR(O$,1,1)="B"THEN 860
: IF STR(O$,1,1)<>"3"THEN 890
0860 GOSUB '97(O$)
: IF Q6$="N"THEN 890
: RETURN
0890 GOSUB 2270
: GOTO 810
0930 IF F$=" "THEN 1030
: GOSUB '243("DO YOU WISH TO SAVE THESE VALUES AS THE SYSTEM DEFAULTS? Y/N
",1)
: IF Q6$="N"THEN 1030
: IF Q6$="Y"THEN 990
: GOSUB 2270
: GOTO 930
0990 DATA LOAD DC OPEN T#0,"DCOMF010"
: DATA SAVE DC #0,M$,I$,O$,E1
: DATA SAVE DC #0,END
1030 GOSUB '248(0,0,4)
: GOSUB '98(1060,2,I$)
: LOAD DC T#0,"SELECT"1060,1060
1060 % SELECT #2 GOES HERE
1070 GOSUB '98(1090,3,O$)
: LOAD DC T#0,"SELECT"1090,1090
1090 % SELECT #3 GOES HERE
1120 IF M$="ALL"THEN 1460
: PRINT HEX(010A);"MOUNT INPUT PLATTER";TAB(64)
: GOSUB '254
: P5=1
1170 PRINT HEX(010A);"ENTER THE NAME OF FILE NUMBER";P5;TAB(48);"0 = END";TAB(
64)
: GOSUB '244(8)
: IF Q6$=" "THEN 1170
: IF Q6$="0"THEN 1380
: MAT SEARCHN$(),=STR(Q6$,1,8)TO B$()
: IF B$(1)=HEX(0000)THEN 1270
1240 PRINT HEX(010A0A0A);"DUPLICATE FILE NAMES ARE NOT ALLOWED"
: GOTO 1170
1270 GOSUB '229(2,Q6$)
: IF R2$<>HEX(10)THEN 1300
: IF STR(R9$(R6),1,2)=HEX(1080)THEN 1330
1300 PRINT HEX(010A0A0A);"FILE - ";Q6$;" - NOT AN ACTIVE PROGRAM FILE"
: GOTO 1170
1330 N$(P5)=Q6$
: PRINT HEX(01);"PREVIOUS FILE NAME = ";Q6$;TAB(64)
: P5=P5+1
: IF C<40THEN 1170
1380 IF P5>1THEN 1450
1390 DEFFN'15
: PRINT HEX(03)
: GOSUB 1490
: COM CLEAR P5
: LOAD DC T#0,"START040"
1450 GOSUB 1490
1460 COM CLEAR I$
: LOAD DC T#0,"DCOM020A"
1490 PRINT HEX(01);TAB(64);"REMOUNT ISS PLATTER IF REMOVED.";TAB(64)
: GOSUB '254
: RETURN
1540 GOSUB '248(6,0,0)
: PRINT ,"ISS DECOMPRESSION"
: PRINT
: PRINT " 1. OPTION = ";M$;TAB(32);"3. INPUT ADDRESS = ";I$
: PRINT " 2. EXTRA SECTORS =";E1;TAB(32);"4. OUTPUT ADDRESS = ";O$
: GOSUB '248(11,0,5)
: RETURN
1620 GOSUB '248(11,0,0)
: PRINT ," ADDRESS AVAILABLE"
: PRINT ," 1 - 310 5 - B10"
: PRINT ," 2 - 320 6 - B20"
: PRINT ," 3 - 330 7 - B30"
: PRINT ," 4 - 350 8 - 360";HEX(01)
: RETURN
1700 DEFFN'242(W0,Q6$)
: IF W0<=0THEN 1750
: IF W0=1THEN 1740
: STR(Q6$,2)=STR(Q6$,1,W0-1)
1740 PRINT Q6$;
1750 RETURN
1770 DEFFN'254
: GOSUB '248(2,0,1)
: INPUT "KEY RETURN(EXEC) TO RESUME ",Q6$
: W4$=Q6$
: GOSUB '248(1,0,3)
: Q6$=W4$
: RETURN
1850 DEFFN'243(Q6$,Q0)
: GOSUB 2300
1870 SELECT CO 205
: Q6$=" "
: INPUT Q6$
: IF Q0=0THEN 2370
: IF LEN(Q6$)<=Q0THEN 2370
: GOSUB 2270
1940 DEFFN'244(Q0)
: GOSUB 2350
: GOSUB 2320
: GOTO 1870
1990 DEFFN'245(Q6$,Q2,Q3)
: Q0=ABS(Q2)+Q3+1
: GOSUB 2300
2020 IF ABS(Q2)+ABS(Q3)=0THEN 2060
: GOSUB '242(ABS(Q2)+2,HEX(09))
: PRINT "/"
: GOTO 2070
2060 PRINT ,," "
2070 GOSUB 2350
: SELECT CO 205
: Q9,W0=-1E-99
: INPUT Q9
: IF W0=Q9THEN 2150
: IF ABS(Q2)+Q3=0THEN 2250
: IF Q9>=0THEN 2220
: IF Q2<=0THEN 2220
2150 GOSUB 2270
2170 DEFFN'246(Q2,Q3)
: Q0=ABS(Q2)+Q3+1
: GOSUB 2350
: GOSUB 2320
: GOTO 2020
2220 IF ABS(Q9)>=10^ABS(Q2)THEN 2150
: W0=ABS(Q9*10^Q3)
: IF INT(W0)<>W0THEN 2150
2250 GOSUB '248(3,0,1)
: RETURN
2270 GOSUB '248(3,0,1)
: PRINT "RE-ENTER"
: RETURN
2300 SELECT PRINT 005(64),CO 005
: PRINT HEX(010A);STR(Q6$,1);
2320 SELECT PRINT 005(64),CO 005
: GOSUB '242(Q0+2,"-")
: PRINT TAB(64)
2350 PRINT HEX(010A0A)
: RETURN
2370 PRINT HEX(0A);TAB(64)
: SELECT PRINT 005(64),CO 005
: RETURN
2410 DEFFN'248(Q6,Q7,Q8)
: GOSUB 2550
: IF Q8<1THEN 2520
: GOSUB 2520
: SELECT PRINT 205
: Q6$=" "
: PRINT STR(Q6$,Q7+1)
: IF Q8<2THEN 2520
: FOR W0=2TO Q8
: PRINT HEX(0A);STR(Q6$,1)
: NEXT W0
2520 PRINT HEX(01)
: GOSUB '242(Q7,HEX(09))
: GOSUB '242(Q6,HEX(0A))
2550 SELECT PRINT 005(64),CO 005
: RETURN
2580 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$)
2740 ADD(STR(R3$,1,1),STR(R3$,2,1))
: R3=VAL(R3$)
: R3=R3-INT(R3/R4)*R4
: R5=R3
2820 DATA LOAD BA T#R9,(R3,R)R9$()
: R6=0
: FOR R7=1TO 16
: IF R3<>0THEN 2900
: IF R7<>1THEN 2900
: R7=2
2900 R2$=STR(R9$(R7),1,1)
: IF R2$=HEX(00)THEN 2990
: IF R2$=HEX(10)THEN 2960
: IF R2$<>HEX(11)THEN 3000
2960 IF STR(R9$(R7),9,8)<>R9$THEN 3000
: R6=R7
2990 R7=16
3000 NEXT R7
: IF R2$=HEX(00)THEN 3130
: IF R6<>0THEN 3130
: R2$=HEX(00)
: R3=R3-1
: IF R3=R5THEN 3130
: IF R3>=0THEN 2820
: R3=R4-1
: GOTO 2820
3130 RETURN
3160 DEFFN'97(Q6$)
: STR(Q6$,4)=HEX(00300131023203330434053506360737083809390A410B420C430D440E
450F462020)
: $TRAN(Q6$<2,2>,Q6$<4>)R
: IF STR(Q6$,2,1)>HEX(0F)THEN 3300
: IF STR(Q6$,3,1)>HEX(0F)THEN 3300
: ROTATE(STR(Q6$,2,1),4)
3230 STR(Q6$,4,1)=STR(Q6$,2,1)
: OR (STR(Q6$,4,1),STR(Q6$,3,1))
: $GIO(02000316122273404400,Q6$)
: IF STR(Q6$,8,1)<>HEX(00)THEN 3300
: Q6$="Y"
: RETURN
3300 Q6$="N"
: F$="N"
: RETURN
3350 DEFFN'98(Q8,Q9,Q6$)
: R9$(1)=HEX(20FF0000A5D7313331300D0000FE)
: PACK(####)STR(R9$(1),3,2)FROMQ8
: CONVERT Q9TO STR(R9$(1),7,1),(#)
: STR(R9$(1),8,3)=Q6$
: LIMITS T#0,"SELECT",Q8,Q9,Q9
: DATA SAVE BA T#0,(Q8+1,Q9)R9$()
: RETURN