image of READY prompt

Wang2200.org

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