Listing of file='ATOM020B' on disk='vmedia/701-2110C.wvd.zip'
# 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