Category : BASIC Source Code
Archive   : BAS2FOR.ZIP
Filename : BASE2FOR.BAS

1000 DEFINT A-Z
1050 DEF FNUM(Q$)=ASC(LEFT$(Q$,1))>47 AND ASC(LEFT$(Q$,1))<58
1100 DEF FNTOGGLE(X$,Y$,FLG)=FLG XOR X$=Y$
1150 DEF FNREP$(X$,Y$,A,B)=LEFT$(X$,A-1)+Y$+MID$(X$,B)
1200 DEF FNINS$(X$,Y$,A,B)=LEFT$(X$,A)+Y$+MID$(X$,B)
1250 TST$(1)="$":TST$(2)="%":TST$(3)="#":TST$(4)="!"
1300 DIM REFLIN!(500),REFER!(500),VALPH$(200),VINT$(200),VDBL$(200),VSNGL$(200)
1350 DIM POINT4!(200,2),STACK4(25),CSTK$(25),TOKLST$(20),PTLST(20),AA(20),BB(20)
1400 DATA " ","(",")","^","*","-","+","=","<",">"
1450 RESTORE 1400:FOR I=1 TO 10:READ DELIM$(I):NEXT
1500 QUOTE$=CHR$(34):BLANK$=CHR$(32):COLON$=":"
1550 NEXTLIN!=0
1600 NN=71
1601 KEY OFF
1650 IREF=0:JREF=0:IINT=0:IALPH=0:IDBL=0:ISNGL=0
1700 TRUE=-1:FALSE=0:PT4=0
1750 IMPFLG=FALSE:XORFLG=FALSE:EQVFLG=FALSE
1800 REM
1850 DIM KFOR$(80),PNTR(1150)
1900 DIM KBAS$(80),HASH(80),TWOS(6)
1950 DIM BUF$(10),CP(10)
2000 DATA ABS,AND,ASC,ATN,BEEP,CDBL,CHR$,CINT,CLOSE,CLS,COMMON
2050 DATA COS,CSNG,DATA,DEF,DEFSNG,DEFDBL,DEFINT,DEFSTR,DIM,ELSE,END
2100 DATA EOF,EQV,EXP,FIX,FN,FOR,GOSUB,GOTO,IF,IMP,INKEY$,INPUT
2150 DATA INPUT#,INPUT$,INT,LET,LOG,LPRINT,MOD,NEXT,NOT,ON,OPEN,OPTION
2200 DATA OR,PRINT,PRINT#,READ,REM,RESTORE,RETURN,SGN,SIN,SPACE$
2250 DATA SPC(,SQR,STEP,STOP,SWAP,TAN,THEN,then,TO,USING,WEND,WHILE,WRITE
2300 DATA WRITE#,XOR
2350 REM unhandled:data,gosub,inkey$,input$,option,read,restore,space$,spc(
2400 REM
2450 DATA 1,2,4,8,16,32
2500 REM
2550 REM
2600 DATA ABS,.AND.,ICHAR,ATAN,*,DBLE,CHAR,ANINT,CLOSE(,*,COMMON
2650 DATA COS,SNGL,DATA,*,IMPLICIT REAL (,IMPLICIT REAL*8 ( ,IMPLICIT INTEGER ( ,CHARACTER*127,DIMENSION,ELSE,END
2700 DATA EOF,*,EXP,IFIX,*,DO,CALL,GOTO,IF(,*,*,"READ(*,*)"
2750 DATA "READ(*,*)",READ,INT,*,ALOG,"WRITE(6,*)",MOD,CONTINUE,.NOT.,ON,OPEN,*
2800 DATA .OR.,"WRITE(*,*)",WRITE,*,C,*,RETURN,SIGN,SIN,*
2850 DATA *,SQRT,",",STOP,*,TAN,],] THEN,",",",",*,CONTINUE,"WRITE(*,*)",WRITE,*
2900 REM
2950 RESTORE 2000
3000 FOR I=1 TO NN:READ A$:KBAS$(I)=SPACE$(8):LSET KBAS$(I)=A$:NEXT
3050 RESTORE 2450:FOR I=1 TO 6:READ TWOS(I):NEXT
3100 RESTORE 2600:FOR I=1 TO NN:READ A$:KFOR$(I)=A$:NEXT
3150 FOR I=1 TO NN
3200 TOKEN$=KBAS$(I)
3250 GOSUB 6900
3300 HASH(I)=S
3350 IF PNTR(HASH(I))=0 THEN PNTR(HASH(I))=I
3400 NEXT I
3450 PRINT"Enter name of BASIC Program ";:INPUT F$
3500 OPEN F$ FOR INPUT AS #1
3550 PRINT "Enter name of FORTRAN Program ";:INPUT G$
3600 OPEN G$ FOR OUTPUT AS #2
3650 PRINT "Do you wish to have source displayed? ";:INPUT ANS$
3700 PRINT
3750 IF LEFT$(ANS$,1)="Y" OR LEFT$(ANS$,1)="y" THEN SHOW=TRUE ELSE SHOW=FALSE
3800 IF SHOW THEN CLS
3850 ON ERROR GOTO 6850
3900 H$="c:WORK":OPEN H$ FOR OUTPUT AS #3: GOTO 4000
3950 H$="b:WORK":OPEN H$ FOR OUTPUT AS #3
4000 ON ERROR GOTO 0
4001 OLIN=0
4002 LOCATE 2,50:COLOR 5,0:PRINT"PASS 1: PARSING"
4050 FOR Z!=1 TO 1000000!
4051 LINE INPUT#1,BUF$(0)
4100 IF EOF(1) THEN 6101
4150 IF INSTR(BUF$(0),"XOR")<>0 THEN XORFLG=TRUE
4200 IF INSTR(BUF$(0),"IMP")<>0 THEN IMPFLG=TRUE
4250 IF INSTR(BUF$(0),"EQV")<>0 THEN EQVFLG=TRUE
4350 FC=INSTR(1,BUF$(0),BLANK$)+1
4400 I=1:LLINES=1:OLIN=OLIN+1:QUOTFLG=FALSE
4450 CM=0
4500 REM
4550 REM fix ELSEs
4600 REM
4650 GOSUB 7800:L=LEN(BUF$(0))
4690 KP=P:P=0
4700 FOR J=I TO L:X$=MID$(BUF$(0),J,1):QUOTFLG=FNTOGGLE(X$,QUOTE$,QUOTFLG): IF (NOT QUOTFLG) AND X$=":" THEN P=J:GOTO 4751
4750 NEXT J
4751 REM
4800 IF P=0 THEN P=(INSTR(KP+1,BUF$(0),"'")):IF P>0 THEN CM=LLINES
4850 IF P>0 THEN CP(LLINES)=P:LLINES=LLINES+1:OLIN=OLIN+1:I=P+1-(CM<>0):GOTO 4690 ELSE GOTO 4900
4900 CP(LLINES)=L+1:CP(0)=0
4950 REM
5000 FOR M=LLINES TO 1 STEP-1
5005 CC=CM=(M-1) AND M>1
5050 BUF$(M)=MID$(BUF$(0),CP(M-1)+1+(CC),CP(M)-CP(M-1)-1-(CC))
5100 NEXT
5150 LINEO!=VAL(BUF$(1)):IF LINEO!<=NEXTLIN! THEN PRINT"ERROR--not enough space to insert logical lines":BEEP:STOP
5200 IF LLINES<2 THEN 5300
5250 FOR K=2 TO LLINES:NEXTLIN!=LINEO!-1+K:L$=STRING$(5," "):BUF$(K)=L$+BLANK$ +BUF$(K):NEXT
5300 IF FC=7 THEN 5351
5350 BUF$(1)=LEFT$(BUF$(1),FC-1)+" "+MID$(BUF$(1),FC):FC=FC+1:GOTO 5300
5351 FOR M=1 TO LLINES
5352 IF MID$(BUF$(M),FC,1)=" " THEN BUF$(M)=LEFT$(BUF$(M),FC-1)+MID$(BUF$(M),FC+1):GOTO 5352
5353 NEXT M
5400 RMFLG=FALSE
5450 FOR I=1 TO LLINES 'for each logical line...
5500 IF MID$(BUF$(1),FC,3)="REM" OR MID$(BUF$(1),FC,1)="'" THEN RMFLG=TRUE
5550 IF (NOT RMFLG) AND MID$(BUF$(I),FC,1)="'" THEN BUF$(I)="C"+BUF$(I)
5600 IF RMFLG THEN BUF$(I)="C"+BUF$(I)
5650 NEXT
5700 IF RMFLG THEN 5950
5750 ON ERROR GOTO 13000
5800 GOSUB 8300 'BUILD TABLE OF REFERENCED LINES
5850 GOSUB 9500 'BUILD TABLE OF CHAR, INT, AND DBL VARS [SINGLE NOT DETECTABLE]
5900 GOSUB 11950 'BUILD FOR/NEXT REF TABLE
5950 FOR I=1 TO LLINES:PRINT#3,BUF$(I)
6000 IF SHOW THEN COLOR 3,1:PRINT BUF$(I):COLOR 7,0
6050 BUF$(I)="":NEXT I
6100 NEXT Z!
6101 GOSUB 30000
6150 CLOSE 1:CLOSE 3:OPEN H$ FOR INPUT AS #1
6200 IF SP<>0 THEN ERROR 82
6250 IF SHOW THEN PRINT
6300 LOCATE 2,50:COLOR 3,0:PRINT"PASS 2: EDITING "
6350 GOSUB 13200 'VAR DEFS
6351 LOUT=0
6400 WHILE NOT EOF(1)
6450 LINE INPUT#1,BUF$(0)
6451 LOUT=LOUT+1
6452 IF OLIN>20 AND (LOUT MOD 20)=0 OR LOUT=1 THEN CLS:GOSUB 30000:LOCATE 2,50: COLOR 3,0:PRINT "PASS 2: EDITING "
6500 FS=INSTR(BUF$(0)," "):LINEO!=VAL(LEFT$(BUF$(0),FS)):L$=MID$(STR$(LINEO!),2)
6550 X$=STRING$(6," "):IF LEFT$(BUF$(0),1)<>"C" THEN MID$(BUF$(0),1,6)=X$
6600 GOSUB 14350:GOSUB 21150:PRINT#2,BUF$(0)
6650 IF SHOW THEN COLOR 1,3:PRINT BUF$(0):COLOR 7,0
6700 WEND
6750 REM
6800 END
6850 RESUME 3950
6900 S=0
6950 FOR J=8 TO 1 STEP -1
7000 ZL=J
7050 W$=MID$(TOKEN$,J,1):IF W$<>" " THEN 7150
7100 NEXT J
7150 IF ZL>6 THEN ZL=6
7200 FOR J=1 TO ZL
7250 W$=MID$(TOKEN$,J,1):X=ASC(W$)-64
7300 S=S+X*TWOS(ZL-J+1)
7350 NEXT J
7400 S=S-23:IF S<0 OR S>1134 THEN S=0
7450 REM RESOLVE COLLISIONS
7500 IF TOKEN$="EOF " THEN S=78:RETURN
7550 IF TOKEN$="SIN " THEN S=79:RETURN
7600 IF TOKEN$="TO " THEN S=80:RETURN
7650 IF TOKEN$="IMP " THEN S=77:RETURN
7700 IF TOKEN$="INT " THEN S=76:RETURN
7750 RETURN
7800 PE=FC:ELSC=0:IF INSTR(BUF$(0),"ELSE")=0 THEN RETURN
7850 ELSP=INSTR(PE,BUF$(0),"ELSE"):IF ELSP=0 THEN 8150
7900 ELSC=ELSC+1:ND=ELSP+4
7950 IF FNUM(MID$(BUF$(0),ND+1,1)) THEN BUF$(0)=FNINS$(BUF$(0),"GOTO ",ND,ND+1)
8000 BUF$(0)=FNINS$(BUF$(0),":",ELSP-1,ELSP):BUF$(0)=FNINS$(BUF$(0),":",ND,ND+1)
8050 IF INSTR(MID$(BUF$(0),PE,ELSP-PE),":")<>0 THEN BUF$(0)=FNINS$(BUF$(0), ":ENDIF",ELSP-2,ELSP-1):ELSP=ELSP+6
8100 PE=ELSP+2:GOTO 7850
8150 FOR K=1 TO ELSC:BUF$(0)=BUF$(0)+":ENDIF":NEXT
8200 IT=INSTR(BUF$(0),"THEN"):BUF$(0)=FNREP$(BUF$(0),"then",IT,IT+4):RETURN
8250 REM
8300 T=1:FOR I=1 TO LLINES
8350 T=1
8400 IF INSTR(MID$(BUF$(I),1),"ON ERROR")=0 THEN 8500
8450 BUF$(I)="C"+BUF$(I):GOTO 9400
8500 Q=INSTR(T,BUF$(I),"GOTO "):IF Q=0 THEN Q=INSTR(T,BUF$(I),"GOSUB ")
8550 IF Q=0 THEN Q=INSTR(T,BUF$(I),"then ")
8600 IF Q<>0 THEN 9050
8650 T0=T:T=INSTR(T,BUF$(I),"THEN ")+5 'IF T=5 THEN T=INSTR(T0,BUF$(I),"then")+5 :IF T>5 THEN IFE=TRUE
8700 IF T=5 THEN T=LEN(BUF$(I))
8750 IF T=LEN(BUF$(I)) THEN 8950
8800 IF NOT FNUM(MID$(BUF$(I),T)) THEN 8950
8850 R$="GOTO " 'IF IFE THEN R$=":GOTO "
8900 BUF$(I)=LEFT$(BUF$(I),T-1)+R$+MID$(BUF$(I),T):Q=T
8950 E=INSTR(T,BUF$(I),"ELSE ")+5:IF T=LEN(BUF$(I)) AND E=5 THEN 9400
9000 IF Q=0 THEN 9400
9050 N=INSTR(Q,BUF$(I)," ")+1
9100 M!=VAL(MID$(BUF$(I),N)):IF M!=0 THEN 9400
9150 FOR K=1 TO IREF:IF REFLIN!(K)=M! THEN 9300:NEXT
9200 IREF=IREF+1:REFLIN!(IREF)=M!
9250 JREF=JREF+1:REFER!(JREF)=LINEO!
9300 NN=INSTR(N,BUF$(I),",")+1:IF NN>N+1 THEN N=NN:GOTO 9100
9350 IF E>5 THEN T=E:GOTO 8750
9400 NEXT I
9450 RETURN
9500 FOR K=1 TO 4
9550 FOR I=1 TO LLINES
9600 P=1
9650 P=INSTR(P+1,BUF$(I),TST$(K)):IF P=0 THEN 10950
9700 T$="":FOR J=P-1 TO 1 STEP -1:X$=MID$(BUF$(I),J,1)
9750 IF(INSTR("=, +*/\()^:<>;-",X$)<>0) THEN 9900
9800 T$=X$+T$
9850 NEXT J
9900 TOKEN$=T$+TST$(K):IF LEN(TOKEN$)=1 THEN 9650
9950 IF LEN(TOKEN$)>=8 THEN 10000 ELSE TOKEN$=TOKEN$+" ":GOTO 9950
10000 GOSUB 6900:IF S<>0 AND TOKEN$=KBAS$(PNTR(S)) THEN P=P+1:GOTO 9650
10050 P=P+1
10100 ON K GOTO 10150,10350,10500,10700
10150 REM ALPHA
10200 FOR N=1 TO IALPH:IF T$=VALPH$(N) THEN 10650
10250 NEXT
10300 IALPH=IALPH+1:VALPH$(IALPH)=T$:GOTO 10650
10350 FOR N=1 TO IINT:IF T$=VINT$(N) THEN 10650
10400 NEXT
10450 IINT=IINT+1:VINT$(IINT)=T$:GOTO 10650
10500 FOR N=1 TO IDBL:IF T$=VDBL$(N) THEN 10650
10550 NEXT
10600 IDBL=IDBL+1:VDBL$(IDBL)=T$:GOTO 10650
10650 GOTO 9650
10700 REM single
10750 FOR N=1 TO ISNGL:IF T$=VSNGL$(N) THEN 10900
10800 NEXT
10850 ISNGL=ISNGL+1:VSNGL$(ISNGL)=T$:GOTO 10900
10900 GOTO 9650
10950 NEXT I
11000 NEXT K
11050 RETURN
11100 TP=0
11150 FOR K=1 TO 10
11200 P=1
11250 P=INSTR(P,BUF$(0),DELIM$(K)):IF P=0 THEN P=LEN(BUF$(0))+1
11300 T$="":FOR J=P-1 TO 1 STEP -1:X$=MID$(BUF$(0),J,1)
11350 IF(INSTR("=, +*/\()^:<>;-",X$)<>0) THEN 11500
11400 T$=X$+T$
11450 NEXT J
11500 TOKEN$=T$ 'TOKEN$=T$+TST$(K)
11550 IF LEN(TOKEN$)>=8 THEN 11600 ELSE TOKEN$=TOKEN$+" ":GOTO 11550
11600 GOSUB 6900:IF S=0 OR TOKEN$<>KBAS$(PNTR(S)) THEN P=P+1:IF P<=LEN(BUF$(0)) THEN 11250 ELSE 11700
11650 TP=TP+1:TOKLST$(TP)=TOKEN$:AA(TP)=P-(J-1):BB(TP)=P:PTLST(TP)=PNTR(S):P=P+1 :IF P<=LEN(BUF$(0)) THEN 11250 ELSE 11750
11700 NEXT K
11750 FOR K=1 TO TP-1:FOR J=K+1 TO TP
11800 IF AA(J)>AA(K) THEN SWAP AA(J),AA(K):SWAP BB(J),BB(K):SWAP TOKLST$(J), TOKLST$(K):SWAP PTLST(J),PTLST(K)
11850 NEXT J:NEXT K
11900 RETURN
11950 FOR I=1 TO LLINES
12000 LNO!=LINEO!+I-1:L2=LEN(BUF$(I))
12050 IF MID$(BUF$(I),FC,4)<>"FOR " THEN 12300
12100 PT4=PT4+1:POINT4!(PT4,1)=LNO!:POINT4!(PT4,2)=-PT4:SP=SP+1:STACK4(SP)=PT4
12150 IF SP<0 THEN ERROR 80 ELSE IF SP>25 THEN ERROR 81
12200 IF I=1 THEN 12300 ELSE L$=MID$(STR$(LNO!),2)
12250 GOSUB 20850:GOTO 12450
12300 IF MID$(BUF$(I),FC,5)="NEXT " OR (L2=FC+3 AND MID$(BUF$(I),FC,4)="NEXT") THEN POINT4!(STACK4(SP),2)=LNO!:SP=SP-1 ELSE 12450
12350 IF I=1 THEN 12450 ELSE L$=MID$(STR$(LNO!),2)
12400 GOSUB 20850
12450 REM WHILE/WEND
12500 IF MID$(BUF$(I),FC,6)<>"WHILE " THEN 12750
12550 PT4=PT4+1:POINT4!(PT4,1)=LNO!:POINT4!(PT4,2)=-PT4:SP=SP+1:STACK4(SP)=PT4: CSTK$(SP)=MID$(BUF$(I),FC+6)
12600 IF SP<0 THEN ERROR 80 ELSE IF SP>25 THEN ERROR 81
12650 IF I=1 THEN 12750 ELSE L$=MID$(STR$(LNO!),2)
12700 GOSUB 20850:GOTO 12900
12750 IF MID$(BUF$(I),FC,5)="WEND " OR (L2=FC+3 AND MID$(BUF$(I),FC,4)="WEND") THEN POINT4!(STACK4(SP),2)=LNO!:BUF$(I)=BUF$(I)+" "+CSTK$(SP):SP=SP-1 ELSE 12900
12800 IF I=1 THEN 12900 ELSE L$=MID$(STR$(LNO!),2)
12850 GOSUB 20850
12900 NEXT I
12950 RETURN
13000 IF ERR=80 THEN PRINT"NEXT OR WEND WITHOUT FOR OR WHILE IN: ":PRINT BUF$(0) :STOP
13050 IF ERR=81 THEN PRINT"TOO MANY NESTED LOOPS AT: ":PRINT BUF$(0):STOP
13100 IF ERR=82 THEN PRINT"FOR WITHOUT NEXT SOMEWHERE IN PROGRAM...":STOP
13150 PRINT ERR,ERL:STOP
13200 IF IALPH>0 THEN PRINT#2," CHARACTER*127 ";
13250 QL=7:CON=FALSE:FOR I=1 TO IALPH-1:QL=QL+LEN(VALPH$(I))+2
13300 IF QL<66 THEN PRINT#2,VALPH$(I)+"$"+","; ELSE QL=7:CON=TRUE:PRINT#2, VALPH$(I)+"$"
13350 IF CON THEN PRINT#2," &";:CON=FALSE
13400 NEXT I:IF IALPH>0 THEN PRINT#2,VALPH$(IALPH)+"$"
13450 IF IINT>0 THEN PRINT#2," INTEGER ";
13500 QL=7:CON=FALSE:FOR I=1 TO IINT-1:QL=QL+LEN(VINT$(I))+2
13550 IF QL<66 THEN PRINT#2,VINT$(I)+"%"+","; ELSE QL=7:CON=TRUE:PRINT#2, VINT$(I)+"%"
13600 NEXT I:IF IINT>0 THEN PRINT#2,VINT$(IINT)+"%"
13650 IF IDBL>0 THEN PRINT#2," REAL*8 ";
13700 QL=7:CON=FALSE:FOR I=1 TO IDBL-1:QL=QL+LEN(VDBL$(I))+2
13750 IF QL<66 THEN PRINT#2,VDBL$(I)+"#"+","; ELSE QL=7:CON=TRUE:PRINT#2, VDBL$(I)+"#"
13800 NEXT I:IF IDBL>0 THEN PRINT#2,VDBL$(IDBL)+"#"
13850 IF ISNGL>0 THEN PRINT#2," REAL ";
13900 QL=7:CON=FALSE:FOR I=1 TO ISNGL-1:QL=QL+LEN(VSNGL$(I))+2
13950 IF QL<66 THEN PRINT#2,VSNGL$(I)+"#"+","; ELSE QL=7:CON=TRUE:PRINT#2, VSNGL$(I)+"!"
14000 NEXT I:IF ISNGL>0 THEN PRINT#2,VSNGL$(ISNGL)+"!"
14050 IF EQVFLG THEN PRINT#2," LOGICAL FEQV"
14100 IF XORFLG THEN PRINT#2," LOGICAL FXOR"
14150 IF IMPFLG THEN PRINT#2," LOGICAL FIMP":PRINT#2," FIMP(X,Y)=((X .AND. Y) .OR. ((.NOT. X) .AND. Y))"
14200 IF XORFLG THEN PRINT#2," FXOR(X,Y)=((X .OR Y) .AND. (.NOT. (X .AND. Y)))"
14250 IF EQVFLG THEN PRINT#2," FEQV(X,Y)=((X .AND. Y) .OR. (.NOT. X) .AND. (.NOT. Y))
14300 RETURN
14350 L=LEN(BUF$(0))
14400 GOSUB 11100
14450 FOR IT=1 TO TP
14451 RW=CSRLIN:CL=POS(0)
14452 LOCATE 25,1:PRINT SPACE$(78);
14453 LOCATE 25,1:COLOR 6,0:PRINT MID$(BUF$(0),7);:LOCATE 25,70:COLOR 2,0:PRINT TIME$;
14454 LOCATE RW,CL
14500 A=AA(IT):B=BB(IT):TOKEN$=TOKLST$(IT):P=PTLST(IT)
14550 IF TOKEN$<>KBAS$(P) THEN S=0:GOTO 18200
14600 IF P>23 THEN 14800
14650 REM 1 TO 23
14700 ON P GOSUB 15200,15250,15250,15250,15300,15250,15250,15250,19000, 15350,15200,15200,15250,15250,15150,17750,17750,17750,15250,15250,15250, 15200,15200
14750 GOTO 15650
14800 IF P>57 THEN 15000
14850 REM 24 TO 57
14900 ON P-23 GOSUB 21800,15200,15250,15150,15950,15200,17250,19200,21600, 15200,31000,15400,15200,15200,15150,15250,15200,21750,19050,15250,17350, 16350,15200,15250,15250,17850,15200,15200,15200,15200,15250,15200,15200, 15200

14950 GOTO 15650
15000 IF P>71 THEN ERROR 89
15050 ON P-57 GOSUB 15250,15250,15200,18300,15200,15250,15800,15250,15200, 18600,19050,15250,17850,21700
15100 GOTO 15650
15150 BUF$(0)=FNREP$(BUF$(0),"",A,B):RETURN
15200 RETURN
15250 BUF$(0)=FNREP$(BUF$(0),KFOR$(P),A,B):RETURN
15300 BUF$(0)=LEFT$(BUF$(0),6)+"WRITE(*,*) CHAR(7)":RETURN
15350 REM CLS:RETURN
15351 RETURN
15400 REM INPUT#
15401 R$=MID$(BUF$(0),B+2)
15450 Q$=MID$(BUF$(0),B):Z7=VAL(MID$(BUF$(0),B)):BUF$(0)=LEFT$(BUF$(0),A-1)+ "READ("
15500 X$=STR$(Z7):BUF$(0)=BUF$(0)+X$+")"+R$:RETURN
15550 REM WRITE#
15600 RETURN
15650 NEXT IT
15700 GOSUB 20900
15750 RETURN
15800 X$=KFOR$(P)+CHR$(13)+CHR$(10)+" "
15850 IF FNUM(MID$(BUF$(0),B+1)) THEN X$=X$+"GOTO "
15900 BUF$(0)=FNREP$(BUF$(0),X$,A,B):RETURN
15950 REM FOR
16000 IF MID$(BUF$(0),FC,4)="OPEN" THEN RETURN
16050 FOR J=1 TO PT4:K=J:IF POINT4!(J,1)=LINEO! THEN 16200
16100 NEXT J
16150 PRINT"error":STOP
16200 X$=STR$(POINT4!(K,2)):X$="DO"+X$
16250 BUF$(0)=FNREP$(BUF$(0),X$,A,B)
16300 RETURN
16350 ACC$=",ACCESS="+CHR$(34)+"SEQUENTIAL"+CHR$(34):RL$=""
16400 FM=1:IF INSTR(BUF$(0),",")<>0 THEN 16850
16450 FS=INSTR(FC,BUF$(0)," "):S2=INSTR(FS+1,BUF$(0)," ")
16500 NAM$=MID$(BUF$(0),FS+1,S2-FS-1)
16550 P3=INSTR(BUF$(0),"#"):IF P3=0 THEN P3=INSTR(BUF$(0)," AS ")+3
16600 FIL=VAL(MID$(BUF$(0),P3+1))
16650 P4=INSTR(BUF$(0),"="):IF P4=0 THEN 16750
16700 RL$=",RECL="+STR$(VAL(MID$(BUF$(0),P4+1))):ACC$=",ACCESS="+CHR$(34)+ "DIRECT"+CHR$(34)
16750 BUF$(0)=" OPEN("+STR$(FIL)+",FILE="+NAM$+",STATUS="+CHR$(34)+"OLD"+ CHR$(34)+ACC$+RL$+")"
16800 RETURN
16850 P1=INSTR(FC,BUF$(0),","):P2=INSTR(P1+1,BUF$(0),",")
16900 P3=INSTR(P2+1,BUF$(0),","):IF P3=0 THEN P3=LEN(BUF$(0))
16950 NAM$=MID$(BUF$(0),P2+1,P3-P2-1)
17000 P4=INSTR(BUF$(0),"#"):IF P4=0 THEN P4=P1
17050 FIL=VAL(MID$(BUF$(0),P4+1))
17100 IF P3 17150 GOTO 16750
17200 RETURN
17250 REM GOTO
17300 RETURN
17350 REM ON
17400 BL(1)=INSTR(FC,BUF$(0)," ")
17450 FOR M=2 TO 3:BL(M)=INSTR(BL(M-1)+1,BUF$(0)," "):NEXT
17500 IF MID$(BUF$(0),BL(2)+1,BL(3)-BL(2)-1)<>"GOTO" THEN RETURN
17550 X$=MID$(BUF$(0),BL(1)+1,BL(2)-BL(1)-1)
17600 Y$="("+MID$(BUF$(0),BL(3)+1)+") "
17650 BUF$(0)=" GOTO "+Y$+X$:RETURN
17700 RETURN
17750 REM DEF---
17800 GOSUB 15250:BUF$(0)=BUF$(0)+")":RETURN
17850 REM PRINT#
17900 P2=INSTR(BUF$(0),","):P1=INSTR(BUF$(0),"#"):FIL$=STR$(VAL(MID$(BUF$(0), P1+1,P2-P1-1)))
17950 FIL$=MID$(FIL$,2)
18000 BUF$(0)=FNREP$(BUF$(0),"WRITE("+FIL$+",*)",FC,P2+1)
18050 RETURN
18100 REM
18150 RETURN
18200 REM SPECIAL ACTION
18250 GOTO 15650
18300 P1=INSTR(FC,BUF$(0)," "):P2=INSTR(BUF$(0),",")
18350 X$=MID$(BUF$(0),P1+1,P2-P1-1):Y$=MID$(BUF$(0),P2+1)
18400 Z$="TEMP$$="+X$+CHR$(13)+CHR$(10)+" "+X$+"="+Y$
18450 Z$=Z$+CHR$(13)+CHR$(10)+" "+Y$+"="+"TEMP$$"
18500 BUF$(0)=LEFT$(BUF$(0),6)+Z$:RETURN
18550 RETURN
18600 REM WEND
18650 BUF$(0)=FNREP$(BUF$(0),"IF(",A,B):GOSUB 19300
18700 FOR J=1 TO PT4:K=J:IF POINT4!(J,2)=LINEO! THEN 18850
18750 NEXT J
18800 PRINT"ERROR":STOP
18850 X$=STR$(POINT4!(K,1))
18900 BUF$(0)=BUF$(0)+")"+" GOTO "+X$
18950 RETURN
19000 GOSUB 15250:BUF$(0)=BUF$(0)+")":RETURN
19050 BUF$(0)=LEFT$(BUF$(0),6)+"CONTINUE"
19150 I=0:GOSUB 20850:RETURN
19200 REM
19250 GOSUB 15250:IFFLG=TRUE
19300 M=0:D=INSTR(BUF$(0),"ELSE"):IF D=0 THEN D=LEN(BUF$(0))
19350 M=M+1:IF M>D THEN 20750
19400 IF MID$(BUF$(0),M,1)="]" THEN IFFLG=FALSE:MID$(BUF$(0),M,1)=")"
19450 P=INSTR("<>=",MID$(BUF$(0),M,1))
19500 IF MID$(BUF$(0),M,3)="IF(" THEN IFFLG=TRUE
19550 IF P=0 OR NOT IFFLG THEN 19350
19600 MM=M+1
19650 Q=INSTR("<>=",MID$(BUF$(0),MM,1)):IF Q=0 THEN MM=M
19700 R=4*Q+P:ON R+1 GOTO 20650,19750,19900,20050,20650,20650,20200,20350,20650, 20200,20650,20500,20650,20350,20500,20650
19750 REM <
19800 BUF$(0)=FNREP$(BUF$(0),".LT.",M,MM+1)
19850 M=MM+2:GOTO 19400
19900 REM >
19950 BUF$(0)=FNREP$(BUF$(0),".GT.",M,MM+1)
20000 M=MM+2:GOTO 19400
20050 REM =
20100 BUF$(0)=FNREP$(BUF$(0),".EQ.",M,MM+1)
20150 M=MM+2:GOTO 19400
20200 REM <>
20250 BUF$(0)=FNREP$(BUF$(0),".NE.",M,MM+1)
20300 M=MM+2:GOTO 19400
20350 REM <=
20400 BUF$(0)=FNREP$(BUF$(0),".LE.",M,MM+1)
20450 M=MM+2:GOTO 19400
20500 REM >=
20550 BUF$(0)=FNREP$(BUF$(0),".GE.",M,MM+1)
20600 M=MM+2:GOTO 19400
20650 REM IMPOSSIBLE...?
20700 GOTO 19400
20750 RETURN
20800 RETURN
20850 IF VAL(L$)>0 THEN FOR NN=1 TO LEN(L$):MID$(BUF$(I),NN,1)=MID$(L$,NN,1):NEXT NN:RETURN
20851 RETURN
20900 REM SEARCH
20950 FOR J=1 TO IREF:K=J:IF REFLIN!(J)=LINEO! THEN 21100
21000 NEXT J
21050 RETURN
21100 I=0:GOSUB 20850:RETURN
21150 REM
21200 L=LEN(BUF$(0))
21250 I=0
21300 I=I+1:IF I>L THEN 21550
21350 X$=MID$(BUF$(0),I,1)
21400 IF X$=CHR$(34) THEN MID$(BUF$(0),I,1)="'" ELSE IF X$="^" THEN BUF$(0)= FNREP$(BUF$(0),"**",I,I+1)
21450 L=LEN(BUF$(0))
21500 GOTO 21300
21550 RETURN
21600 REM IMP
21650 FUN$=" IMP":FUN2$="FIMP(":GOSUB 21850:RETURN
21700 FUN$=" XOR":FUN2$="FXOR(":GOSUB 21850:RETURN
21750 FUN$=" MOD":FUN2$="AMOD(":GOSUB 21850:RETURN
21800 FUN$=" EQV":FUN2$="FEQV(":GOSUB 21850:RETURN
21850 REM general
21900 P=INSTR(BUF$(0),FUN$)
21950 Y$="":FOR I=P-1 TO 1 STEP -1:X$=MID$(BUF$(0),I,1)
22000 IF(INSTR("=, +*/\()^:<>;-",X$)<>0) THEN 22100
22050 Y$=X$+Y$:NEXT I
22100 R=P+5:FOR Q=R TO LEN(BUF$(0)):X$=MID$(BUF$(0),Q,1)
22150 IF(INSTR("=, +*/\()^:<>;-",X$)<>0) THEN 22250
22200 NEXT Q
22250 X$=")":Z$=MID$(BUF$(0),R,Q-R+1):IF Z$="(" THEN Z$="":X$=""
22300 BUF$(0)=FNREP$(BUF$(0),FUN2$+Y$+","+Z$+X$,I+1,Q):RETURN
30000 LOCATE 3,50:COLOR 4,0:PRINT"SOURCE LINES:";Z!
30001 LOCATE 4,50:COLOR 6,0:PRINT"OUTPUT LINES:";OLIN
30002 RETURN
31000 IF MID$(BUF$(0),FC,4)="OPEN" THEN RETURN
31005 IF MID$(BUF$(0),B+1,1)="#" THEN P=P+1:B=B+2:GOTO 15400
31100 GOSUB 15250:RETURN
ID$(BUF$(0),FC,4)="OPEN" THEN RETURN
31005 IF MID$(BUF$(0),B+1,1)="#" THEN P