image of READY prompt

Wang2200.org

Listing of file='SORT300B' on disk='vmedia/701-2047D.wvd.zip'

# Sector 228, program filename = 'SORT300B'
0010 REM SORT300B,00-00(02/18/76),12003A - COPYRIGHT WANG LABS. INC., 1976
0180 COM X1$(56)2,X2$56,X3$56,X5$64,X6$64,X8$64,X9$10
   : COM U,S8,S2,L3,P1,B,C,N
   : COM K0,B$10,N$10,D9$2,K$2,B1$3,B2$3,B3$2,X1$2,Y$1,X4$2
   : COM Y1$1,R0$3,X0$1,D$(4)64,U1$2,U2$(2)2,Z$8,X$40
0205 RETURN
3100 DATA LOAD DA T#2,(P0$,X1$)X2$,X3$,X6$,X8$,X9$,U,S8,L3,K0,B$,N$,B3,G2
   : IF C$="X"THEN 3370
   : PRINT "OUTPUT FILE  ";O$;TAB(45);"CATALOGUED  ";C$
   : P7=(INT((R2-1)/R0)+1)*B3+2
   : IF F=0THEN 3200
   : IF F=2THEN 3200
   : P7=P7+4
3200 IF D$<>"D"THEN 3240
   : IF R1$="R"THEN 3370
   : STOP "DEFERRED MOUNTING INVALID"
3240 IF C$="N"THEN 3330
   : X,Y=0
   : LIMITS T#3,O$,X,Y,Z
   : IF P7<=Y-X+1THEN 3370
   : IF G$<>" "THEN 3370
   : IF H$<>" "THEN 3370
   : STOP "OUTPUT SPACE TOO SMALL"
3330 DATA SAVE DC OPEN T$#3,P7,O$
   : DATA SAVE DC CLOSE#3
3370 CONVERT P2TO B2$,(###)
   : CONVERT R0TO R0$,(###)
   : U1$="SR"
   : CONVERT KTO U2$(1),(##)
   : CONVERT L3-KTO U2$(2),(##)
   : P3=(P6+1)*2
   : S3=K*P2
   : R3=(L3-K)*P2
   : X4$="A0"
   : FOR P=1TO S8
   : CONVERT P-1TO X1$,(##)
   : AND (X1$,0F)
   : ADDC(X1$,X4$)
   : X1$(P)=X1$
   : NEXT P
3610 FOR S2=1TO K0
   : STR(X5$,S2,1)="S"
   : NEXT S2
   : IF U=1THEN 3790
   : IF R1$="K"THEN 3790
   : Y1$=HEX(01)
   : FOR P=1TO S8
   : IF STR(X2$,P,1)=HEX(02)THEN 3760
   : S2=S2+1
   : STR(X5$,S2,1)="R"
   : STR(X6$,S2,1)=Y1$
   : ADDC(Y1$,STR(X3$,P,1))
   : BIN(STR(X8$,S2,1))=P
3760 NEXT P
3790 P1=1
   : D9$=S1$
   : GOSUB '5
   : Y=3140
   : Y$=" "
   : GOSUB '4
   : X0$=HEX(00)
   : GOSUB '15(P9,P4)
   : X$="X3$(000)2,"
   : STR(X$,5,3)=B1$
   : GOSUB '1(10)
   : IF R2$="S"THEN 3920
   : GOSUB '18(P4)
3920 GOSUB '14
   : GOSUB '9
   : IF R2$="L"THEN 4010
   : GOSUB '10(3310,11)
   : X$="P=0:"
   : GOSUB '1(4)
   : GOSUB '9
4010 IF F=0THEN 4380
   : IF F=2THEN 4170
   : IF F=3THEN 4322
   : GOSUB '10(3450,23)
   : X$=HEX(59243DD30000242851292C322C31293A)
   : STR(X$,5,2)=X1$(1)
   : A=16
   : IF R0>1THEN 4090
   : STR(X$,8)=STR(X$,11)
   : A=13
4090 GOSUB '1(A)
   : X$=HEX(9F59243D223322B1FF42803A)
   : GOSUB '1(12)
   : STR(X$,6,1)="2"
   : GOSUB '1(12)
   : GOSUB '9
   : GOTO 4380
4170 GOSUB '10(3440,30)
   : X$=HEX(9F52343D31B1FF34503A9A273233372831293A)
   : GOSUB '1(19)
   : X$=HEX(9F51243D222022B1FF34503A)
   : GOSUB '1(12)
   : STR(X$,6,1)="E"
   : STR(X$,10,2)=HEX(4280)
   : GOSUB '1(12)
4280 X$=HEX(95224B46414D2052454144204552524F52223A)
   : GOSUB '1(19)
   : GOSUB '9
   : GOSUB '10(3450,33)
   : X$=HEX(5032243D5434243AE843285032242C4E3424293A9AFF36503A)
   : GOSUB '1(25)
   : GOSUB '9
   : GOTO 4380
4322 GOSUB '10(3450,35)
   : Y$=X2$
   : IF Y$=HEX(01)THEN 4346
   : IF Y$=HEX(03)THEN 4346
   : X$=HEX(9FD34130242851292C312C31293DD2464629B1FF42803A)
   : X=6
   : A=23
   : GOTO 4354
4346 X$=HEX(9F41302851293D39453939B1FF42803A)
   : X=4
   : A=16
4354 IF R0>1THEN 4364
   : IF Y$=HEX(03)THEN 4364
   : STR(X$,X)=STR(X$,X+3)
   : A=A-3
4364 GOSUB '1(A)
   : GOSUB '9
4380 GOSUB '10(3560,45)
   : IF R1$="R"THEN 4440
   : X$=HEX(DED352242C3329293D513A)
   : GOSUB '1(11)
4440 FOR R=1TO K0
   : X=VAL(STR(X8$,R,1))
   : IF STR(X9$,R,1)=HEX(00)THEN 4550
   : X$=HEX(8C28D3)
   : STR(X$,4)="A0$(Q),00,00),FF):"
   : STR(X$,4,2)=X1$(X)
   : P=VAL(STR(B$,R))+1
   : CONVERT PTO STR(X$,11,2),(##)
   : P=VAL(STR(N$,R))
   : CONVERT PTO STR(X$,14,2),(##)
   : IF R0>1THEN 4540
4500 IF STR(X2$,X,1)=HEX(03)THEN 4540
   : STR(X$,7)=STR(X$,10)
   : GOSUB '1(18)
   : GOTO 4550
4540 GOSUB '1(21)
4550 NEXT R
   : FOR R=1TO S2
   : X=VAL(STR(X8$,R,1))
   : P=VAL(STR(X6$,R,1))
   : CONVERT PTO K$,(##)
   : IF STR(X2$,X,1)=HEX(03)THEN 5030
   : IF STR(X2$,X,1)=HEX(01)THEN 5050
4650 IF P=1THEN 4720
   : X$=HEX(D300242C0000293D)
   : A=9
   : STR(X$,2,1)=STR(X5$,R,1)
   : STR(X$,5,2)=K$
   : GOTO 4760
4720 X$="A$="
   : A=4
   : STR(X$,1,1)=STR(X5$,R,1)
4760 Q3=A
   : STR(X$,A,2)=X1$(X)
   : STR(X$,A+2,1)="$"
   : A=A+3
4810 IF STR(X2$,X,1)=HEX(03)THEN 4830
   : IF R0=1THEN 4860
4830 STR(X$,A,3)="(Q)"
   : A=A+3
4860 IF STR(X2$,X,1)<>HEX(02)THEN 4980
   : IF STR(B$,R,1)=HEX(00)THEN 4980
   : Z$=STR(X$,Q3)
   : STR(X$,Q3+1)=Z$
   : STR(X$,Q3,1)=HEX(D3)
   : STR(X$,A+1,7)=",00,00)"
   : Q2=VAL(STR(B$,R,1))+1
   : CONVERT Q2TO STR(X$,A+2,2),(##)
   : Q2=VAL(STR(N$,R,1))
   : CONVERT Q2TO STR(X$,A+5,2),(##)
4960 A=A+8
4980 STR(X$,A,1)=HEX(3A)
   : GOSUB '1(A)
   : NEXT R
   : GOTO 5180
5030 IF STR(X5$,R,1)="S"THEN 4650
5050 IF STR(X6$,R,1)>HEX(01)THEN 5110
   : X$=HEX(00243D2220223A)
   : STR(X$,1,1)=STR(X5$,R,1)
   : GOSUB '1(7)
5110 X$=HEX(E2282B232E2323232323232323232323235E5E5E5E29D300242C00002946524F4D
     0000)
   : STR(X$,24,1)=STR(X5$,R,1)
   : STR(X$,27,2)=K$
   : STR(X$,34,2)=X1$(X)
   : A=36
   : GOTO 4810
5180 GOSUB '9
   : GOSUB '10(3580,15)
   : X$="A0$(C)=A$:"
   : FOR R=1TO U
   : STR(X$,1,1),STR(X$,8,1)=STR(U1$,R,1)
   : GOSUB '1(10)
   : NEXT R
   : GOSUB '9
   : Y=3650
   : IF R1$="R"THEN 5370
   : GOSUB '10(Y,14)
   : X$="R$=P2$:"
   : GOSUB '1(7)
   : GOSUB '9
   : Y=3651
5370 X=4
   : P=K0
   : IF R0=1THEN 5420
   : X=6
   : P=0
5420 Y1=22+S8*X+P
   : GOSUB '10(Y,Y1)
   : X$=HEX(97A1BD5423312C285032242C50322429)
   : GOSUB '1(16)
   : X0$=HEX(00)
   : GOSUB '11
   : GOSUB '9
   : P=0
   : FOR R=1TO K0
   : X=VAL(STR(X8$,R,1))
   : IF STR(X2$,X,1)<>HEX(03)THEN 5610
   : IF P=1THEN 5580
   : P=1
   : GOSUB '10(3670,20)
5580 X$=HEX(A8AE00002829B200002428293A)
   : STR(X$,3,2),STR(X$,8,2)=X1$(X)
   : GOSUB '1(13)
5610 NEXT R
   : IF P=0THEN 5640
   : GOSUB '9
5640 IF R2$="L"THEN 5800
   : GOSUB '10(3760,12)
   : X$=HEX(9CFF38303A)
   : GOSUB '1(5)
   : GOSUB '9
   : GOSUB '10(3800,12)
   : X$=HEX(9CFF40503A)
   : GOSUB '1(5)
   : GOSUB '9
   : B1$="S0$"
   : GOTO 5876
5800 GOSUB '10(3730,30)
   : X$=HEX(A8AD00302428292C533424283129B2002428502C31293A)
   : FOR R=1TO U
   : STR(X$,3,1),STR(X$,16,1)=STR(U1$,R,1)
   : GOSUB '1(23)
   : NEXT R
   : GOSUB '9
   : B1$="S$"
5876 GOSUB '17(3880)
   : IF G2=0THEN 5920
   : GOSUB '10(3942,45)
   : X$=HEX(9F4E32243C3D523724B1FF39503A9522)
   : STR(X$,17)="WORK SPACE TOO SMALL"
   : STR(X$,37)=HEX(223A)
   : GOSUB '1(38)
   : GOSUB '9
5920 GOSUB '10(3950,28+6*U)
   : X$=HEX(9785BD542423322C284D32242C4D3224294E32242C)
   : GOSUB '1(21)
   : GOSUB '22("1")
   : GOSUB '9
   : GOSUB '21
   : P1=2
   : D9$=S2$
   : GOSUB '5
   : IF R1$="K"THEN 6090
   : LOAD DC T#0,"SORT300C"3100,6999
6090 LOAD DC T#0,"SORT300D"3100,6999
7120 DEFFN'1(X1)
   : IF N+X1<252THEN 7240
   : Y=Y+1
   : N=N-1
   : GOSUB '2
   : Y$=STR(D$(B),C,1)
   : STR(D$(B),C,4)=HEX(0D0000FD)
   : GOSUB '3
   : GOSUB '4
7240 STR(D$(B),C)=STR(X$,1,X1)
   : X2=65-C
   : IF X2>=X1THEN 7290
   : D$(B+1)=STR(X$,X2+1)
7290 N=N+X1
   : GOSUB '2
   : RETURN
7330 DEFFN'4
   : D$(1)=HEX(00FF)
   : PACK(####)STR(D$(1),3,2)FROMY
   : N=5
   : IF Y$=HEX(3A)THEN 7410
   : STR(D$(1),5,1)=HEX(93)
   : N=6
7410 GOSUB '2
   : RETURN
7440 DEFFN'2
   : B=INT((N-1)/64)+1
   : C=N-(B-1)*64
   : RETURN
7490 DEFFN'3
   : DATA SAVE BA T$#2,(D9$,D9$)D$()
   : RETURN
7530 DEFFN'5
   : D$(1)=HEX(40FFFFFFFFFFFFFFFFFD)
   : GOSUB '3
   : RETURN
7580 DEFFN'8
   : IF R0=1THEN 7630
7600 STR(X$,A,5)="(000)"
   : STR(X$,A+1,3)=R0$
   : A=A+5
7630 RETURN
7650 DEFFN'9
   : N=N-1
   : GOSUB '2
   : X$=HEX(0D0000)
   : IF N>240THEN 7720
   : GOSUB '1(3)
   : RETURN
7720 STR(D$(B),C,3)=X$
   : N=N+3
   : GOSUB '2
   : RETURN
7800 DEFFN'10(Y,Y1)
   : IF N+Y1<250THEN 7870
   : STR(D$(B),C,1)=HEX(FD)
   : GOSUB '3
   : STR(D$(1),1,1)=HEX(00)
   : N=2
   : GOSUB '2
7870 X$=HEX(FF)
   : PACK(####)STR(X$,2,2)FROMY
   : GOSUB '1(3)
   : RETURN
7920 DEFFN'11
   : FOR X=1TO S8
   : X$=X1$(X)
   : ADD(STR(X$,1,1),X0$)
   : A=3
   : IF STR(X2$,X,1)=HEX(01)THEN 8030
   : IF STR(X2$,X,1)<>HEX(03)THEN 8010
   : IF P1=1THEN 8040
   : GOTO 8030
8010 STR(X$,3,1)="$"
   : A=4
8030 IF R0=1THEN 8060
8040 STR(X$,A,2)=HEX(2829)
   : A=A+2
8060 STR(X$,A,1)=HEX(2C)
   : GOSUB '1(A)
   : NEXT X
   : RETURN
8120 DEFFN'14
   : FOR X=1TO S8
   : X$=X1$(X)
   : A=3
   : IF STR(X2$,X,1)=HEX(01)THEN 8280
   : IF STR(X2$,X,1)<>HEX(03)THEN 8200
   : IF P1=1THEN 8290
   : GOTO 8280
8200 STR(X$,3,1)="$"
   : A=4
   : GOSUB '8
   : R=VAL(STR(X3$,X,1))
   : CONVERT RTO STR(X$,A,2),(##)
   : A=A+2
   : GOTO 8300
8280 IF R0=1THEN 8400
8290 GOSUB 7600
8300 STR(X$,A,1)=HEX(2C)
   : ADD(STR(X$,1,1),X0$)
   : GOSUB '1(A)
   : IF STR(X2$,X,1)<>HEX(03)THEN 8400
   : IF P1>1THEN 8400
   : X$="A0$(000)8,"
   : STR(X$,1,2)=X1$(X)
   : STR(X$,5,3)=R0$
   : GOSUB '1(10)
8400 NEXT X
   : RETURN
8440 DEFFN'15(P,X)
   : CONVERT XTO B3$,(##)
   : CONVERT PTO B1$,(###)
   : FOR A=UTO 1STEP -1
   : X$="A1$(000)00,A0$(000)00,A$00,A$(00,000)00,"
   : STR(X$,5,3)=B2$
   : STR(X$,16,3)=B1$
   : STR(X$,31,2)=B3$
   : STR(X$,34,3)=B2$
8530 STR(X$,1,1),STR(X$,12,1),STR(X$,23,1),STR(X$,28,1)=STR(U1$,A,1)
   : STR(X$,9,2),STR(X$,20,2),STR(X$,25,2),STR(X$,38,2)=U2$(A)
   : IF P1<4THEN 8600
   : X$=STR(X$,12)
   : GOSUB '1(29)
   : GOTO 8660
8600 IF P1>1THEN 8650
   : IF R2$="L"THEN 8650
   : GOSUB '1(27)
   : GOTO 8660
8650 GOSUB '1(40)
8660 NEXT A
   : RETURN
8730 DEFFN'17(X)
   : GOSUB '10(X,32)
   : X$=HEX(A8AD20202028292C5334242847292C52B2003124284F293A)
   : STR(X$,3,3)=B1$
   : FOR R=1TO U
   : STR(X$,3,1),STR(X$,18,1)=STR(U1$,R,1)
   : GOSUB '1(24)
   : NEXT R
   : GOSUB '9
   : RETURN
8850 DEFFN'18(X)
   : X$="S6$(00)2,S5$(00)1,"
   : CONVERT XTO STR(X$,5,2),(##)
   : CONVERT X+1TO STR(X$,14,2),(##)
   : GOSUB '1(18)
   : RETURN
8930 DEFFN'21
   : STR(D$(B),C,1)=HEX(FE)
   : STR(D$(1),1,1)=HEX(20)
   : GOSUB '3
   : RETURN
9010 DEFFN'22(B1$)
   : X$="S0$(),"
   : STR(X$,2,1)=B1$
   : FOR R=1TO U
   : STR(X$,1,1)=STR(U1$,R,1)
   : GOSUB '1(6)
   : NEXT R
   : RETURN