image of READY prompt

Wang2200.org

Listing of file='ATOM020B' on disk='vmedia/701-2110C.wvd.zip'

# Sector sector 193, program filename = 'ATOM020B'
0010 REM ATOM020B,00-00(04/21/78),12014
0400 DIM C$(16)16
   : DIM D$(4)62
   : DIM F1$4,F2$4,F3$4,F4$4,F5$4,F6$4
   : DIM E$(3)64,E1$(2)2,E3$(193)2,E9$(124)16
   : DATA LOAD DC OPEN T#1,"ATOMF010"
   : DATA LOAD DC #1,E9$()
   : DATA SAVE DC CLOSE#1
   : F1$=HEX(A001)
   : F2$=HEX(A002)
   : F3$=HEX(A003)
   : F4$=HEX(A004)
0590 F5$=HEX(A00A)
   : F6$=HEX(A010)
   : GOSUB '248(0,0,4)
   : PRINT HEX(010A);"MOUNT INPUT AND OUTPUT DISK."
   : GOSUB '254
   : GOSUB '248(0,0,4)
   : PRINT TAB(11);HEX(5F);"STRING BEING TESTED FOR KEYWORD"
   : PRINT
   : PRINT "LINE BEING PROCESSED"
   : D=0
   : C=0
0780 GOSUB 3390
   : IF D=-1THEN 3290
   : $GIO/005(4001400A400A400AA200400D400A,A$)E$(1)
   : $GIO/005(A200400D400A,A$)E$(2)
   : $GIO/005(A2004001,A$)E$(3)
   : IF NUM(E$(1))=0THEN 780
   : E1=POS(E$(1)="%")
   : IF E1<>NUM(E$(1))+1THEN 950
0900 E2$=HEX(F020F222F727D8252020)
   : $TRAN(E$()<E1,E-E1+1>,E2$)R
   : GOTO 1300
0950 E2$="REM"
   : MAT SEARCHE$(),=E2$TO E1$()
   : E1=VAL(STR(E1$(1),2,1))
   : IF E1=NUM(STR(E$(1),1,POS(E$(1)>39)))+1THEN 900
1020 INIT(00)E3$(),E1$()
   : E2$=HEX(22)
   : MAT SEARCHE$(),=E2$TO E3$()
   : E2$=HEX(27)
   : MAT SEARCHE$(),=E2$TO E1$()
   : E2$=HEX(F020F222F7272020)
   : ON SGN(VAL(STR(E3$(1),2,1))-VAL(STR(E1$(1),2,1)))+1GOTO 1300,1160
   : MAT COPY E1$()TO E3$()
1160 IF E3$(2)<>HEX(0000)THEN 1200
   : $TRAN(E$()<E3$(1),1>,E2$)R
   : GOTO 1020
1200 XOR (E3$(2),FF)
   : ADDC(E3$(2),01)
   : ADDC(E3$(2),E3$(1))
   : XOR (E3$(2),FF)
   : ADDC(E3$(2),03)
   : $TRAN(E$()<E3$(1),E3$(2)>,E2$)R
   : GOTO 1020
1300 E5=NUM(STR(E$(1),1,POS(E$(1)>39)))
   : IF E5>4THEN 1340
   : MAT COPY -E$()<E5+1,188-E5>TO -E$()<5,188>
1340 CONVERT STR(E$(1),1,E5)TO E4
   : STR(E$(1),1,E5)=" "
   : E4=E4-INT(E4/10000)*10000
   : STR(E$(1),1,2)=HEX(00FF)
   : PACK(####)STR(E$(1),3,2)FROME4
   : E2$=HEX(F0202020)
   : $TRAN(E$()<1,4>,E2$)R
   : E2$=" "
   : MAT SEARCHE$(),<>E2$TO E3$()
1500 E2$=HEX(0000)
   : MAT SEARCHE3$(),=E2$TO E1$()
   : E=INT((256*VAL(E1$(1))+VAL(STR(E1$(1),2,1)))/2)
   : $IF ON /000,1580
   : MAT COPY E3$()<2,385>TO E3$()
   : E2$=HEX(01002020)
   : $TRAN(E3$(),E2$)R
1580 MAT REDIM E$(192)1
   : MAT MOVE E$(),E3$(1),ETO E$(1)
   : MAT REDIM E$(3)64
   : E2$=HEX(20F022F227F72020)
   : $TRAN(E$(),E2$)R
   : MAT COPY -E$()<5,186>TO -E$()<5,187>
   : E=E+1
   : E2$=HEX(EA242020)
   : $TRAN(E$()<6,1>,E2$)R
   : E2$=HEX(0D0000FD)
1720 $PACK(F=F4$)E$()<E+1,4>FROME2$
   : E=E+4
   : IF STR(E$(1),6,1)=HEX(D8)THEN 2710
   : E1=5
1800 J=0
1810 E1=E1+1
   : IF E1>=E-4THEN 2710
   : $UNPACK(F=F1$)E$()<E1,1>TO E2$
   : IF E2$=HEX(22)THEN 1870
   : IF E2$<>HEX(27)THEN 1920
1870 MAT SEARCHE$()<E1+1,E-E1>,=E2$TO E3$()
   : IF E3$(1)=HEX(0000)THEN 1810
   : E1=E1+VAL(STR(E3$(1),2,1))
   : GOTO 1810
1920 $UNPACK(F=F5$)E$()<E1>TO STR(E2$,2)
   : I1=10
   : E1$=HEX(F02828F0F13D3DF12020)
   : $TRAN(E2$,E1$)R
   : IF POS(STR(E2$,2,10)<41)=0THEN 2030
   : I1=POS(STR(E2$,2)<41)-1
   : STR(E2$,I1+2)=" "
2030 $TRAN(E2$,E1$)R
   : IF I1<2THEN 1800
   : IF STR(E2$,2,1)<"A"THEN 1800
   : IF STR(E2$,2,1)>"Z"THEN 1800
   : FOR I=I1TO 2STEP -1
   : STR(E2$,I+2)=" "
   : $GIO/005(4001A200,A$)E2$<2,10>
   : BIN(STR(E2$,1,1))=I
   : MAT SEARCHE9$(),=E2$TO E1$()STEP 16
2150 IF E1$(1)=HEX(0000)THEN 2190
   : J=I
   : I=1
2190 NEXT I
   : IF J=0THEN 1800
   : E2$=STR(E9$(INT((256*VAL(E1$(1))+VAL(STR(E1$(1),2,1)))/16)+1),12)
   : IF E2$="BT"THEN 1800
   : $PACK(F=F2$)E$()<E1,2>FROME2$
   : MAT COPY E$()<E1+J,E-(E1+J)+1>TO E$()<E1+LEN(E2$),193-(E1+LEN(E2$))>
   : E1=E1+LEN(E2$)-1
2280 E=E-J+LEN(E2$)
   : IF E2$=HEX(B1)THEN 2440
   : IF E2$=HEX(A7)THEN 2440
   : IF E2$=HEX(9C)THEN 2440
   : IF E2$=HEX(9A)THEN 2440
   : IF E2$=HEX(A2)THEN 2710
   : IF E2$<>HEX(D2)THEN 1800
   : E2$=")"
   : GOTO 1870
2440 GOSUB 2480
   : GOTO 1800
2480 $UNPACK(F=F6$)E$()<E1+1>TO E2$
   : E5=NUM(STR(E2$,1,16))
   : IF E5=0THEN 2670
   : CONVERT STR(E2$,1,NUM(E2$))TO E4
   : E4=E4-INT(E4/10000)*10000
   : E2$=HEX(FF)
   : PACK(####)STR(E2$,2,2)FROME4
   : ON SGN(E5-3)+1GOTO 2630,2610
2580 MAT COPY -E$()<E1+1,192-E1+E5-3>TO -E$()<E1+1,192-E1>
   : GOTO 2630
2610 MAT COPY E$()<E1+E5,192-E1-E5>TO E$()<E1+3,189-E1>
2630 $PACK(F=F3$)E$()<E1+1,3>FROME2$
   : E=E-E5+3
   : E1=E1+4
   : GOTO 2480
2670 RETURN
2710 IF STR(E$(1),6,1)=HEX(88)THEN 2940
   : IF STR(E$(1),6,3)=HEX(EA9F94)THEN 3030
   : IF STR(E$(1),6,1)=HEX(A1)THEN 3160
2800 IF STR(E$(1),6,1)=HEX(A2)THEN 2850
2820 MAT COPY -E$()<6,183>TO -E$()<6,187>
   : E=E+4
2850 GOSUB 3710
   : GOTO 780
2880 E2$=HEX(D723B744DB47D950B6522020)
   : $TRAN(E$()<5>,E2$)R
   : GOTO 2820
2940 MAT COPY -E$()<1,E-4>TO E3$()
   : E2$=HEX(2C)
   : MAT SEARCHE3$(),=E2$TO E1$()
   : E1=E-3-VAL(STR(E1$(2),2,1))
   : GOTO 3260
3030 E1=8
   : IF NUM(STR(E$(1),9,1))<>0THEN 3260
   : E1=10
   : IF STR(E$(1),9,1)="#"THEN 3110
   : E1=12
3110 E1=E1+SGN(POS(E$(1)=2C))
   : GOTO 3260
3160 MAT COPY -E$()<1,E-4>TO E3$()
   : $UNPACK(F=F6$)E3$()TO E2$
   : IF NUM(STR(E2$,1,1))<>1THEN 2800
   : E1=NUM(E2$)
   : IF STR(E2$,E1+1,1)<>","THEN 3250
   : E1=E1+NUM(STR(E2$,E1+2))
3250 E1=E-5-E1
3260 GOSUB 2480
   : GOTO 2820
3290 GOSUB 3710
3310 DEFFN '31
   : PRINT HEX(030A);"RE-MOUNT SYSTEM DISK IF REMOVED."
   : GOSUB '254
   : COM CLEAR E$
   : LOAD DC T#1,"MENU010A"
3390 IF D=0THEN 3560
3410 IF VAL(STR(D$(1),2,1))=DTHEN 3610
   : MAT COPY D$()<D,1>TO E3$()
   : D1=VAL(E3$(1))
   : MAT COPY D$()<D+1,D1>TO E$()<1,192>
   : D=D+D1+1
   : E=124+LEN(E$(3))
   : IF E$(3)<>" "THEN 3530
   : E=62+LEN(E$(2))
   : IF E$(2)<>" "THEN 3530
   : E=LEN(E$(1))
3530 RETURN
3560 DATA LOAD DC OPEN T#2,E$
   : INIT(20)D$()
   : D=1
3610 IF STR(D$(1),1,1)=HEX(F0)THEN 3660
   : DATA LOAD DC #2,D$()
   : D=3
   : GOTO 3410
3660 D=-1
   : RETURN
3710 IF D=-1THEN 3790
   : IF C=0THEN 4010
   : IF C+E>255THEN 4140
3740 MAT COPY E$()<1,E>TO C$()<C,E>
   : C=C+E-2
   : RETURN
3790 IF C<=0THEN 3980
   : STR(C$(1),1,1)=HEX(20)
   : E$(1)=HEX(FEFD2020)
   : $TRAN(C$(),E$(1))R
   : DATA SAVE BA T#3,(C0,C0)C$()
   : DATA LOAD DC OPEN T#3,E$
   : DSKIP #3,(C0-C1)S
   : DATA SAVE DC #3,END
   : GOSUB '227(3,E$,1)
   : LIMITS T#3,E$,C1,C0,C1
   : DATA LOAD BA T#3,(C0,C0)C$()
3900 STR(C$(1),1,1)=HEX(20)
   : INIT(FF)C$(2)
   : ADDC(STR(C$(1),2,2),STR(C$(2),2,2))
   : DATA SAVE BA T#3,(C0-1,C0)C$()
   : GOSUB '229(3,E$)
   : STR(R9$(R6),2,1)=HEX(80)
   : DATA SAVE BA T#3,(R3,R)R9$()
3980 RETURN
4010 GOSUB '228(3,E$,50)
   : IF R2$="0"THEN 4050
   : PRINT HEX(010A);"ERROR - RETURN CODE FROM ALLOCATE DATA FILE SPACE = ";R2
     $
   : STOP
4050 LIMITS T#3,E$,C1,C,C
   : C0=C1
   : C$(1)=HEX(402020202020202020FD)
   : STR(C$(1),2,8)=E$
   : DATA SAVE BA T#3,(C0,C0)C$()
   : C=1
   : GOTO 3740
4140 DATA SAVE BA T#3,(C0,C0)C$()
   : INIT(00)C$()
   : C=1
   : GOTO 3740