Listing of file='COMP010A' on disk='vmedia/701-2048D.wvd.zip'
# Sector 446, program filename = 'COMP010A'
0010 REM COMP010A,00-00(02/18/76),12003A - COPYRIGHT WANG LABS. INC., 1976
0160 COM P5,N$(40)8,M$4,P9,I$3,O$3
: DIM R1$8,R2$1,R3$2,R9$8,R9$(16)
: DIM Q6$64,B$(1)2
: PRINT HEX(03)
: DATA LOAD DC OPEN T#0,"COMPF010"
: DATA LOAD DC #0,M$,I$,O$,P9
: GOSUB 710
: GOSUB 820
: GOSUB 1520
0300 GOSUB '243("ARE THE PARAMETERS OK? Y/N",1)
: IF Q6$="Y"THEN 930
: IF Q6$="N"THEN 350
: GOSUB 2170
: GOTO 300
0350 F$="N"
0380 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 2170
: GOTO 380
0450 Q6$=I$
: I$=O$
: O$=Q6$
: GOTO 510
0500 ON Q9GOSUB 540,620,690,800
0510 GOSUB 1520
: GOTO 380
0540 GOSUB '243("ENTER THE DESIRED MODE. (ALL OR PART)",4)
: IF Q6$="ALL"THEN 590
: IF Q6$="PART"THEN 590
: GOSUB 2170
: GOTO 540
0590 M$=Q6$
: RETURN
0620 GOSUB '245("ENTER THE DESIRED COMPRESSION OPTION. (1-180 OR 2-256)",1,0)
: IF (Q9-1)*(Q9-2)=0THEN 660
: GOSUB 2170
: GOTO 620
0660 P9=177+76*INT(Q9/2)
: RETURN
0690 GOSUB '243("ENTER THE INPUT ADDRESS.",3)
: I$=Q6$
0710 IF I$=O$THEN 770
: IF STR(I$,1,1)="B"THEN 740
: IF STR(I$,1,1)<>"3"THEN 770
0740 GOSUB '97(I$)
: IF Q6$="N"THEN 770
: RETURN
0770 GOSUB 2170
: GOTO 690
0800 GOSUB '243("ENTER THE OUTPUT ADDRESS.",3)
: O$=Q6$
0820 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 2170
: GOTO 800
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 2170
: GOTO 930
0990 DATA LOAD DC OPEN T#0,"COMPF010"
: DATA SAVE DC #0,M$,I$,O$,P9
: DATA SAVE DC #0,END
1030 GOSUB '98(1050,2,I$)
: LOAD DC T#0,"SELECT"1050,1050
1050 % SELECT #2 GOES HERE
1060 GOSUB '98(1080,3,O$)
: LOAD DC T#0,"SELECT"1080,1080
1080 % SELECT #3 GOES HERE
1110 IF M$="ALL"THEN 1440
: PRINT HEX(010A);"MOUNT INPUT PLATTER";TAB(64)
: GOSUB '254
: P5=1
1160 PRINT HEX(010A);"ENTER THE NAME OF FILE NUMBER";P5;TAB(48);"0 = END";TAB(
64)
: GOSUB '244(8)
: IF Q6$=" "THEN 1160
: IF Q6$="0"THEN 1370
: MAT SEARCHN$(),=STR(Q6$,1,8)TO B$()
: IF B$(1)=HEX(0000)THEN 1260
1230 PRINT HEX(010A0A0A);"DUPLICATE FILE NAMES ARE NOT ALLOWED"
: GOTO 1160
1260 GOSUB '229(2,Q6$)
: IF R2$<>HEX(10)THEN 1290
: IF STR(R9$(R6),1,2)=HEX(1080)THEN 1320
1290 PRINT HEX(010A0A0A);"FILE - ";Q6$;" - NOT AN ACTIVE PROGRAM FILE"
: GOTO 1160
1320 N$(P5)=Q6$
: PRINT HEX(01);"PREVIOUS FILE NAME = ";Q6$;TAB(64)
: P5=P5+1
: IF C<40THEN 1160
1370 IF P5>1THEN 1430
1380 DEFFN'15
: COM CLEAR P5
: GOSUB 1460
: LOAD DC T#0,"START040"
1430 GOSUB 1460
1440 LOAD DC T#0,"COMP010B"
1460 GOSUB '248(0,0,4)
: PRINT HEX(010A);"REMOUNT ISS PLATTER IF REMOVED"
: GOSUB '254
: RETURN
1520 GOSUB '248(6,0,0)
: PRINT TAB(20);"ISS COMPRESSION"
: PRINT
: PRINT TAB(8);"1. MODE = ";M$;TAB(32);"3. INPUT ADDRESS = ";I$
: PRINT TAB(8);"2. OPTION =";P9+3;TAB(32);"4. OUTPUT ADDRESS = ";O$
: GOSUB '248(11,0,5)
: RETURN
1600 DEFFN'242(W0,Q6$)
: IF W0<=0THEN 1650
: IF W0=1THEN 1640
: STR(Q6$,2)=STR(Q6$,1,W0-1)
1640 PRINT Q6$;
1650 RETURN
1670 DEFFN'254
: GOSUB '248(2,0,1)
: INPUT "KEY RETURN(EXEC) TO RESUME ",Q6$
: W4$=Q6$
: GOSUB '248(1,0,3)
: Q6$=W4$
: RETURN
1750 DEFFN'243(Q6$,Q0)
: GOSUB 2200
1770 SELECT CO 205
: Q6$=" "
: INPUT Q6$
: IF Q0=0THEN 2270
: IF LEN(Q6$)<=Q0THEN 2270
: GOSUB 2170
1840 DEFFN'244(Q0)
: GOSUB 2250
: GOSUB 2220
: GOTO 1770
1890 DEFFN'245(Q6$,Q2,Q3)
: Q0=ABS(Q2)+Q3+1
: GOSUB 2200
1920 IF ABS(Q2)+ABS(Q3)=0THEN 1960
: GOSUB '242(ABS(Q2)+2,HEX(09))
: PRINT "/"
: GOTO 1970
1960 PRINT ,," "
1970 GOSUB 2250
: SELECT CO 205
: Q9,W0=-1E-99
: INPUT Q9
: IF W0=Q9THEN 2050
: IF ABS(Q2)+Q3=0THEN 2150
: IF Q9>=0THEN 2120
: IF Q2<=0THEN 2120
2050 GOSUB 2170
2070 DEFFN'246(Q2,Q3)
: Q0=ABS(Q2)+Q3+1
: GOSUB 2250
: GOSUB 2220
: GOTO 1920
2120 IF ABS(Q9)>=10^ABS(Q2)THEN 2050
: W0=ABS(Q9*10^Q3)
: IF INT(W0)<>W0THEN 2050
2150 GOSUB '248(3,0,1)
: RETURN
2170 GOSUB '248(3,0,1)
: PRINT "RE-ENTER"
: RETURN
2200 SELECT PRINT 005(64),CO 005
: PRINT HEX(010A);STR(Q6$,1);
2220 SELECT PRINT 005(64),CO 005
: GOSUB '242(Q0+2,"-")
: PRINT TAB(64)
2250 PRINT HEX(010A0A)
: RETURN
2270 PRINT HEX(0A);TAB(64)
: SELECT PRINT 005(64),CO 005
: RETURN
2310 DEFFN'248(Q6,Q7,Q8)
: GOSUB 2450
: IF Q8<1THEN 2420
: GOSUB 2420
: SELECT PRINT 205
: Q6$=" "
: PRINT STR(Q6$,Q7+1)
: IF Q8<2THEN 2420
: FOR W0=2TO Q8
: PRINT HEX(0A);STR(Q6$,1)
: NEXT W0
2420 PRINT HEX(01)
: GOSUB '242(Q7,HEX(09))
: GOSUB '242(Q6,HEX(0A))
2450 SELECT PRINT 005(64),CO 005
: RETURN
2480 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$)
2640 ADD(STR(R3$,1,1),STR(R3$,2,1))
: R3=VAL(R3$)
: R3=R3-INT(R3/R4)*R4
: R5=R3
2720 DATA LOAD BA T#R9,(R3,R)R9$()
: R6=0
: FOR R7=1TO 16
: IF R3<>0THEN 2800
: IF R7<>1THEN 2800
: R7=2
2800 R2$=STR(R9$(R7),1,1)
: IF R2$=HEX(00)THEN 2890
: IF R2$=HEX(10)THEN 2860
: IF R2$<>HEX(11)THEN 2900
2860 IF STR(R9$(R7),9,8)<>R9$THEN 2900
: R6=R7
2890 R7=16
2900 NEXT R7
: IF R2$=HEX(00)THEN 3030
: IF R6<>0THEN 3030
: R2$=HEX(00)
: R3=R3-1
: IF R3=R5THEN 3030
: IF R3>=0THEN 2720
: R3=R4-1
: GOTO 2720
3030 RETURN
3060 DEFFN'97(Q6$)
: STR(Q6$,4)=HEX(00300131023203330434053506360737083809390A410B420C430D440E
450F462020)
: $TRAN(Q6$<2,2>,Q6$<4>)R
: IF STR(Q6$,2,1)>HEX(0F)THEN 3200
: IF STR(Q6$,3,1)>HEX(0F)THEN 3200
: ROTATE(STR(Q6$,2,1),4)
3130 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 3200
: Q6$="Y"
: RETURN
3200 Q6$="N"
: F$="N"
: RETURN
3250 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