image of READY prompt

Wang2200.org

Listing of file='SORT400C' on disk='vmedia/701-2425A.wvd.zip'

# Sector 67, program filename = 'SORT400C'
0015 REM SORT400C,08/09/77,COPYRIGHT WANG LABS.1976
4000 %#
7310 DIM R1$8,R2$1,R9$8,R9$(16)
   : DIM Q5$64,Q6$64
7340 DEFFN'217(R9$,R9,R8,R1,Q9,Q6$,R4$,R2)
   : Q$="D"
   : GOSUB '215(R4$,1)
   : GOSUB '229(R9,R9$)
   : IF ABS(R)=1THEN 7630
   : IF R1<=0THEN 7460
   : IF R2$=HEX(10)THEN 7630
   : Q$="S"
   : Q9=4
   : Q5$=STR(Q6$,1,16)
   : IF R2$=HEX(00)THEN 7440
   : LIMITS T#R9,R9$,Q6,Q7,Q8
   : IF Q7-Q6+1<R1THEN 7630
   : DATA SAVE DC OPEN T#R9,R9$,R9$
   : GOTO 7480
7440 DATA SAVE DC OPEN T#R9,R1,R9$
   : LIMITS T#R9,Q6,Q7,Q8
   : GOTO 7480
7460 IF R2$<>HEX(10)THEN 7630
   : LIMITS T#R9,R9$,Q6,Q7,Q8
   : Q5$=STR(Q6$,1,16)
7480 GOSUB 7875
   : IF STR(R9$(1),4,4)<>HEX(FD4D5558)THEN 7510
   : R1$=HEX(A040)
   : $UNPACK(F=R1$)R9$()<17,64>TO Q5$
7510 Q$="P"
   : IF STR(Q5$,1,16)<>STR(Q6$,1,16)THEN 7630
   : Q$="A"
   : Q6$=STR(Q5$,17)
   : IF SGN(VAL(STR(Q6$,R8,1))-32)<>-INT(SGN(R1)/2)THEN 7630
   : STR(Q6$,R8,1)=" "
   : ON Q9-1GOTO 7560,7570,7580
   : R1$=" 1 2 3"
   : GOTO 7575
7560 R1$=" 1 2"
   : GOTO 7575
7570 R1$=" 1 3"
7575 $TRAN(Q6$,R1$)R
7580 IF Q6$<>" "THEN 7630
   : CONVERT Q9TO STR(Q5$,16+R8,1),(#)
   : R1$=HEX(A040)
   : $PACK(F=R1$)R9$()<17,64>FROMQ5$
   : STR(R9$(1),4,4)=HEX(FD4D5558)
   : GOSUB 7890
   : DATA LOAD DC OPEN T#R9,R9$
   : Q$=" "
7630 GOSUB '215(R4$,R2)
   : RETURN
7650 DEFFN'218(R9$,R9,R4$,R2)
   : GOSUB '215(R4$,1)
   : LIMITS T#R9,Q6,Q7,Q8
   : Q6=Q8-Q6+2
   : R9$(1)=HEX(A0)
   : DATA SAVE BA T#R9,(Q8,Q9)R9$()
   : GOSUB 7875
   : BIN(STR(R9$(1),2,1))=INT(Q6/256)
   : BIN(STR(R9$(1),3,1))=Q6-INT(Q6/256)*256
   : GOSUB 7890
   : DATA LOAD DC OPEN T#R9,R9$
   : DSKIP #R9,END
   : GOTO 7630
7760 DEFFN'219(R9$,R9,R8,R4$,R2)
   : GOSUB '215(R4$,1)
   : LIMITS T#R9,R9$,Q6,Q7,Q8
   : GOSUB 7875
   : Q$=" "
   : $TRAN(R9$()<32+R8,1>,Q$)00
   : GOSUB 7890
   : DATA SAVE DC CLOSE#R9
   : GOTO 7630
7840 DEFFN'215(R4$,Q4)
   : CONVERT STR(R4$,2,2)TO R
   : PACK(##)STR(R4$,5,1)FROMR
   : BIN(STR(R4$,10,1))=128*SGN(Q4)
   : $GIO(732070A0400086000300044012324670,R4$<4>)
   : RETURN
7875 DATA LOAD BA T#R9,(Q7,Q8)R9$()
   : RETURN
7890 DATA SAVE BA T#R9,(Q7,Q8)R9$()
   : RETURN
7905 DEFFN'229(R9,R9$)
   : DATA LOAD BA T#R9,(0,R3)R9$()
   : R4=VAL(STR(R9$(1),2))
   : R1$=R9$
   : XOR (STR(R1$,2),R1$)
   : R=3*VAL(STR(R1$,8))
   : R=INT(R/256)+R-INT(R/256)*256
   : R3,R5=R-INT(R/R4)*R4
7960 DATA LOAD BA T#R9,(R3,R)R9$()
   : R,R6=0
   : FOR R7=2-SGN(R3)TO 16
   : R2$=STR(R9$(R7),1,1)
   : IF R2$=HEX(00)THEN 8015
   : IF R2$=HEX(21)THEN 8020
   : IF STR(R9$(R7),9)<>R9$THEN 8020
   : R=SGN(16.5-VAL(R2$))*(2-SGN(VAL(STR(R9$(R7),2,1))))
   : R6=R7
8015 RETURN
8020 NEXT R7
   : R2$=HEX(00)
   : R3=R3-1
   : IF R3=R5THEN 8015
   : IF R3>=0THEN 7960
   : R3=R4-1
   : GOTO 7960