Listing of file='ISS.031U' on disk='vmedia/701-2423D.wvd.zip'
# Sector 350, program filename = 'ISS.031U'
0010 REM ISS.031U, RELEASE 5-1, (11/07/79) - COPYRIGHT WANG LABS. INC.
0068 DIM Z5$60,E$64
: DIM N1$8,N2$8
: DIM P$(1250)1,M$(8)1,I$(256)1,R9$(16)16,P$10,P1$10,O$(256)1,L$(256)2,W$(2
52)1,C$1,G$8
0120 % THIS MUST BE STATEMENT 120
0290 S1$="ISS.254SISS.226SISS.227SISS.229SISS.217S"
: LOAD DC T#0,<LEN(S1$)/8>S1$10,0BEG 310
0310 IF S$(1)<>" "THEN SELECT #4<S$(1)>
: IF F9$=" "THEN 390
0340 PRINT AT(1,0);"MOUNT PLATTERS AT INDICATED ADDRESSES"
: GOSUB '254
: DATA LOAD BA T#1,(0)I$()
: ERRORGOTO 340
0370 DATA LOAD BA T#2,(0)I$()
: ERRORGOTO 340
0390 D=0
0410 GOSUB '91
: IF N1$=HEX(0000000000000000)THEN GOSUB '31
: D=D+1
: PRINT AT(0,0);"COMPRESSING FILE #";D
: PRINT "INPUT - ";N1$;" OUTPUT - ";N2$;TAB(64)
: LIMITS T#1,N1$,A1,A2,A3,A4
: ERRORGOTO 3430
0490 IF A4<>1THEN 3430
: DATA LOAD BA T#1,(A1)I$()
: AND (I$(1),F0)
: IF I$(1)<>HEX(50)THEN 590
: E$="FILE "&N1$&" IS PROTECTED"
: GOSUB '92(E$)
: GOTO 410
0590 E1=MAX(1.1*A3,A3+5)
: DATA SAVE DC OPEN T#2,(E1)N2$
: ERRORGOTO 3430
0620 LIMITS T#2,N2$,B1,B2,B3
: GOSUB 940
: DATA LOAD BA T#1,(A1)O$()
: STR(O$(),2,8)=N2$
: DATA SAVE BA T#2,(B1)O$()
: GOSUB 1200
: DATA LOAD DC OPEN T#2,N2$
: DSKIP #2,ES
: DATA SAVE DC #2,END
: $OPEN #2
: GOSUB '227(2,N2$,1)
: LIMITS T#2,N2$,B1,B2,B3
: DATA LOAD BA T#2,(B2)O$()
: O$(1)=HEX(20)
: STR(O$(),2,2)=SUBCHEX(0001)
: DATA SAVE BA T#2,(B2)O$()
: GOSUB '229(2,N2$)
: STR(R9$(R6),2,1)=HEX(80)
0870 DATA SAVE BA T#2,(R3)R9$()
: $CLOSE#2
: GOTO 410
0940 P$()=ALL(HEX(00))
: M$()=HEX(8040201008040201)
: FOR I=A1+1TO A1+A3-2
: DATA LOAD BA T#1,(I)I$()
: IF I<A1+A3-2THEN STR(I$(),POS(I$()=HEX(FD)))=" "
: ELSE STR(I$(),POS(I$()=HEX(FE)))=" "
: P=4
1060 P1=POS(STR(I$(),P+1)=HEX(FF))
: IF P1=0THEN 1140
: P=P+P1
: IF I$(P-1)=HEX(00)THEN 1060
: UNPACK(####)STR(I$(),P+1,2)TO L
: P$(INT(L/8)+1)=OR M$(MOD(L,8)+1)
: GOTO 1060
1140 NEXT I
: RETURN
1200 L9,W,O9=0
: E=1
: F$="0"
: G=B1+1
: FOR I=A1+1TO A3+A1-2
: DATA LOAD BA T#1,(I)I$()
: GOSUB 1480
1320 P=POS(I$()=HEX(0D))+1
: IF P=1THEN 1400
: L9=L9+1
: GOSUB 2160
: I$()=STR(I$(),P+1)
: GOTO 1320
1400 NEXT I
: GOSUB 3190
: RETURN
1480 P$=HEX(FB20FC22FD27FE3A2020)
: P1$=HEX(20FB22FC27FD3AFE2020)
: IF I<A1+A3-2THEN STR(I$(),POS(I$()=HEX(FD)))=" "
: ELSE STR(I$(),POS(I$()=HEX(FE)))=" "
: I$(1)=HEX(00)
: P=0
1560 P1=POS(STR(I$(),P+1)=HEX(FF))
: IF P1=0THEN 1620
: P=P+P1
: $TRAN(STR(I$(),P+1,2),P$)R
: GOTO 1560
1620 P=0
1630 P1=POS(STR(I$(),P+1)=HEX(D8))
: IF P1=0THEN 1710
: P=P+P1
: P1=POS(STR(I$(),P+1)=HEX(0D))
: $TRAN(STR(I$(),P,P1),P$)R
: P=P+1
: GOTO 1630
1710 P=0
1720 P1=POS(STR(I$(),P+1)=HEX(A2))
: IF P1=0THEN 1810
: P=P+P1
: P2=POS(STR(I$(),P+1)=HEX(0D))
: P3=POS(STR(I$(),P+1,P2)=HEX(3A))
: IF P3=0THEN P1=P2
: ELSE P1=P3
: $TRAN(STR(I$(),P,P1),HEX(FC22FD27FE3A2020))R
: GOTO 1720
1810 P=0
1820 P2=POS(STR(I$(),P+1)=HEX(CE))
: P3=POS(STR(I$(),P+1)=HEX(9A))
: IF P2*P3=0THEN P1=MAX(P2,P3)
: ELSE P1=MIN(P2,P3)
: IF P1=0THEN 1900
: P=P+P1
: $TRAN(STR(I$(),P+POS(STR(I$(),P+1)<>" "),1),P$)R
: GOTO 1820
1900 P=0
1910 P2=POS(STR(I$(),P+1)=HEX(27))
: P3=POS(STR(I$(),P+1)=HEX(22))
: IF P2*P3=0THEN P1=MAX(P2,P3)
: ELSE P1=MIN(P2,P3)
: IF P1=0THEN 2020
: P=P+P1
: P1=POS(STR(I$(),P+1)=I$(P))
: IF P1=0THEN 1910
: $TRAN(STR(I$(),P,P1),P$)R
: P=P+P1
: GOTO 1910
2020 IF L9=0AND POS(I$()=0D)<>0THEN $TRAN(STR(I$(),1,POS(I$()=0D)),P$)R
: MAT SEARCHI$(),<>" "TO L$()
: P=256
: MAT MOVE I$(),L$(),PTO I$()
: STR(I$(),P+1)=" "
: $TRAN(STR(I$(),1,P),P1$)R
: RETURN
2160 UNPACK(####)STR(I$(),3,2)TO L
: IF L9=1THEN 2760
2200 IF POS(STR(I$(),1,P)=HEX(A2))<>0THEN 2850
: IF P-5>OTHEN 3300
: IF W+P>O+1THEN 2390
: IF F$="1"THEN 2390
: C$=P$(INT(L/8)+1)AND M$(MOD(L,8)+1)
: IF C$<>HEX(00)THEN 2390
: IF I$(5)=HEX(D8)THEN 2390
: IF I$(5)=HEX(CE)THEN 2390
: GOTO 2480
2390 IF W<>0THEN GOSUB 2590
: W$()=" "
: W$()=STR(I$(),1,P-2)
: W=P-2
: GOTO 2520
2480 STR(W$(),W+1)=":"&STR(I$(),5,P-6)
: W=W+P-5
2520 F$="0"
: IF I$(5)=HEX(A1)OR I$(5)=HEX(D8)OR I$(5)=HEX(9C)OR I$(5)=HEX(9B)OR POS(ST
R(I$(),1,P)=HEX(EB))<>0THEN F$="1"
: RETURN
2590 IF W+O9<=252THEN 2680
: STR(O$(),O9+1)=HEX(00FD)
: DATA SAVE BA T#2,(G,G)O$()
: E=E+1
: IF E>E1-3THEN 3370
: O$()=" "
: O9=0
2680 STR(O$(),O9+1)=STR(W$(),1,W)&HEX(0D00)
: O9=O9+W+2
: RETURN
2760 IF P-5>OTHEN 3300
: O$()=STR(I$(),1,P)
: O9=P
: F$="1"
: RETURN
2850 IF I$(5)=HEX(A2)AND I$(6)=HEX(0D)THEN 3060
: P1=POS(STR(I$(),1,P)=HEX(A2))
: P2=POS(STR(I$(),P1+1,P-P1)=HEX(3A))
: IF P2=0THEN P2=P-P1-1
: MAT COPY STR(I$(),P1+P2)TO STR(I$(),P1)
: P=P-P2
: IF P=6THEN 3080
: IF I$(P1)<>HEX(3A)THEN 3010
: MAT COPY STR(I$(),P1+1)TO STR(I$(),P1)
: P=P-1
3010 IF I$(P1)=HEX(0D)AND I$(P1-1)=HEX(3A)THEN MAT COPY STR(I$(),P1)TO STR(I$(
),P1-1)
: ELSE GOTO 2200
: P=P-1
: GOTO 2200
3060 F$="1"
3080 C$=P$(INT(L/8)+1)AND M$(MOD(L,8)+1)
: IF C$=HEX(00)THEN RETURN
: CONVERT LTO S1$,(####)
: Z5$=STR(N1$,1)&" - REM REFERENCED, LINE "&STR(S1$,1,4)
: GOSUB '92(Z5$)
: RETURN
3190 IF W>0THEN GOSUB 2590
: STR(O$(),O9+1)=HEX(00FE)
: O$(1)=HEX(20)
: DATA SAVE BA T#2,(G,G)O$()
: E=E+1
: RETURN
3300 CONVERT LTO S1$,(####)
: Z5$=STR(N1$,1)&" CANNOT BE COMPRESSED - LINE LENGTH ERROR ("&STR(S1$,1,4
)&")"
: GOSUB '92(Z5$)
: RETURN CLEAR ALL
3340 GOSUB '99(N2$,2)
: GOTO 410
3370 Z5$=STR(N1$,1)&" CANNOT BE COMPRESSED - FILE LENGTH ERROR"
: GOSUB '92(Z5$)
: RETURN CLEAR ALL
3400 GOSUB '99(N2$,2)
: GOTO 410
3430 Z5$=STR(N1$,1)&" CANNOT BE COMPRESSED - ERROR IN OPEN"
: GOSUB '92(Z5$)
: GOTO 410
3490 DEFFN'91
: IF Z9$="INDIRECT"THEN 3780
: IF Z9$="PART"THEN 3670
: IF Z9=0THEN N1$=ALL(HEX(00))
: IF Z9=0THEN Z9=1
3570 GOSUB '226(1,N1$)
: N1$,N2$=R9$
: IF N1$=HEX(0000000000000000)THEN RETURN
: IF R<>1THEN 3570
: IF N1$<Z1$(1)THEN 3570
: IF N1$>Z2$(1)THEN 3570
: RETURN
3670 Z8=Z8+1
: IF Z8>Z9THEN 3750
: N1$=Z1$(Z8)
: N2$=Z2$(Z8)
: N=VAL(Z3$(Z8))-1
: RETURN
3750 N1$=ALL(HEX(00))
: RETURN
3780 MAT REDIM Z1$(14)8,Z2$(14)8,Z3$(14)1
: IF Z9=0THEN Z8=0
3810 IF Z9=0THEN GOSUB '217(Z8$,3,S2,-2,2,"ISS 4.0 REF"," ",0)
: IF Q$<>" "THEN 4000
: IF Z9=0THEN Z9=1
3850 IF Z8=0THEN DATA LOAD DC #3,STR(Z1$(),1),STR(Z2$(),1),STR(Z3$(),1)
: IF END THEN 3960
: Z8=Z8+1
: N1$=Z1$(Z8)
: N2$=Z2$(Z8)
: N=VAL(Z3$(Z8))-1
: IF Z8=14THEN Z8=0
: IF N1$=" "THEN 3850
: RETURN
3960 N1$=ALL(HEX(00))
: GOSUB '219(Z8$,3,S2," ",0)
: RETURN
4000 PRINT AT(1,0);"ERROR IN REFERENCE FILE OPEN = ";Q$
: GOSUB '254
: GOTO 3810
4060 DEFFN'92(Z5$)
: IF S$(1)=" "THEN 4180
: GOSUB '94
: SELECT PRINT <S$(1)>
: IF N3$=" "THEN PRINT HEX(0C0E);"COMPRESSION ERRORS"
: IF N3$<>N2$THEN PRINT
: N3$=N2$
: PRINT Z5$
: SELECT PRINT 005
: RETURN
4180 PRINT AT(1,0);Z5$;TAB(S0)
: GOSUB '254
: RETURN
4240 DEFFN'94
4260 $OPEN 4340,#4
: $CLOSE#4
4280 $GIO#4(010A02001212400040004000,A$)
: IF STR(A$,8,1)=HEX(00)THEN RETURN
: PRINT AT(1,0,S0);"SELECT PRINTER"
: GOSUB '254
: GOTO 4280
4340 PRINT AT(1,0,S0);"PRINTER HOGGED"
: GOSUB '254
: GOTO 4260
4400 DEFFN'99(G$,G9)
: LIMITS T#G9,G$,G6,G7,G8
: GOSUB '229(G9,G$)
: $OPEN #G9
: STR(R9$(R6),1,1)=HEX(21)
: DATA SAVE BA T#G9,(R3)R9$()
: DATA LOAD BA T#G9,(0)R9$()
: STR(R9$(),3,1)=AND HEX(7F)
: IF G7+1<>VAL(STR(R9$(),3,2),2)THEN 4530
: STR(R9$(),3,2)=BIN(G6,2)
: DATA SAVE BA T#G9,(0)R9$()
4530 $CLOSE#G9
: RETURN
4580 DEFFN'31
: SELECT PRINT 005
: $CLOSE#4
: PRINT HEX(03)
: IF Z8$<>" "THEN GOSUB '219(Z8$,3,S2," ",0)
: COM CLEAR Z9$
4640 LOAD DC T#0,"ISS.100M"
: ERRORGOTO 4650
4650 PRINT HEX(010A);"MOUNT ISS DISK AT ADDRESS ";S$
: GOSUB '254
: GOTO 4640