10 REM **********BASIC FORTH V. 3 ************
11 ' by C. H. Ting
12 ' PO BOX 504, Sunnyvale, CA 94086
13 ' converted to IBM PC by Art Bevilacqua, 14 Arthur St. Danvers, Ma 01923
14 ' See Dr. Dobbs Journal Number 60, October 1981 for the base article
20 DIM S(40),R(20),L(10),LO(10)
30 DIM I$(80)
40 PRINT "BASIC FORTH VERSION V.3"
50 REM N IS SP, M IS RP, K IS IP, AND L IS W.
60 ON ERROR GOTO 90
70 ON KEY(1) GOSUB 2340
80 GOTO 100
90 PRINT A$," ?"
100 M=0
110 N=0
120 REM ************ TEXT INTERPRETER  ************
130 K=1
140 INPUT I$
150 L1=0
160 L(K)=L1
170 LO(K)=LEN(I$)
180 L1=LO(K)
190 IF N<0 THEN GOTO 210
200 GOTO 230
210 PRINT "STACK EMPTY"
220 GOTO 100
230 L(K)=L(K)+1
240 IF L(K)>LO(K) THEN GOTO 350
250 B$=MID$(I$,L(K),1)
260 IF B$=" " THEN GOTO 230
270 A$=B$
280 L(K)=L(K)+1
290 IF L(K)>LO(K) THEN GOTO 340
300 B$=MID$(I$,L(K),1)
310 IF B$=" " THEN GOTO 340
320 A$=A$+B$
330 GOTO 280
340 GOTO 400
350 IF K<2 THEN GOTO 130
360 K=K-1
370 I$=MID$(I$,1,LO(K))
380 L1=LO(K)
390 GOTO 230
400 REM ***********  DICTIONARY **********
410 REM 300-900 :: HIGH LEVEL DEFINITIONS
420 IF A$<>"SQUARE" THEN GOTO 470
430 B$="DUP *"
440 I$=I$+B$
450 K=K+1
460 GOTO 160
470 IF A$<>"CUBE" THEN GOTO 520
480 B$="DUP SQUARE *"
490 I$=I$+B$
500 K=K+1
510 GOTO 160
520 IF A$<>"TEST" THEN GOTO 570
530 B$="DO PI 10 / R@ * SIN . LOOP"
540 I$=I$+B$
550 K=K+1
560 GOTO 160
570 REM
580 REM *************** LOW LEVEL DEFINITIONS NUCLEUS **********
590 IF A$<>"+" THEN GOTO 630
600 N=N-1
610 S(N)=S(N)+S(N+1)
620 GOTO 190
630 IF A$<>"-" THEN GOTO 670
640 N=N-1
650 S(N)=S(N)-S(N+1)
660 GOTO 190
670 IF A$<>"*" THEN GOTO 710
680 N=N-1
690 S(N)=S(N)*S(N+1)
700 GOTO 190
710 IF A$<>"/" THEN GOTO 750
720 N=N-1
730 S(N)=S(N)/S(N+1)
740 GOTO 190
750 IF A$<>"ABS" THEN GOTO 780
760 S(N)=ABS(S(N))
770 GOTO 190
780 IF A$<>"ATN" THEN GOTO 810
790 S(N)=ATN(S(N))
800 GOTO 190
810 IF A$<>"COS" THEN GOTO 840
820 S(N)=COS(S(N))
830 GOTO 190
840 IF A$<>"EXP" THEN GOTO 870
850 S(N)=EXP(S(N))
860 GOTO 190
870 IF A$<>"INT" THEN GOTO 900
880 S(N)=INT(S(N))
890 GOTO 190
900 IF A$<>"LOG" THEN GOTO 930
910 LET S(N)=LOG(S(N))
920 GOTO 190
930 IF A$<>"RND" THEN GOTO 960
940 S(N)=RND(-N)
950 GOTO 190
960 IF A$<>"SGN" THEN GOTO 990
970 S(N)=SGN(S(N))
980 GOTO 190
990 IF A$<>"SIN" THEN GOTO 1020
1000 S(N)=SIN(S(N))
1010 GOTO 190
1020 IF A$<>"SQR" THEN GOTO 1050
1030 S(N)=SQR(S(N))
1040 GOTO 190
1050 IF A$<>"TAN" THEN GOTO 1080
1060 S(N)=TAN(S(N))
1070 GOTO 190
1080 IF A$<>"^" THEN GOTO 1120
1090 N=N-1
1100 S(N)=S(N)^S(N+1)
1110 GOTO 190
1120 IF A$<>"S?" THEN GOTO 1170
1130 FOR I=1 TO N
1140 PRINT S(N-I+1)
1150 NEXT I
1160 GOTO 190
1170 IF A$<>"." THEN GOTO 1220
1180 IF N<1 THEN GOTO 210
1190 PRINT S(N)
1200 N=N-1
1210 GOTO 190
1220 IF A$<>"DUP" THEN GOTO 1260
1230 N=N+1
1240 S(N)=S(N-1)
1250 GOTO 190
1260 IF A$<>"DROP" THEN GOTO 1290
1270 N=N-1
1280 GOTO 190
1290 IF A$<>"SWAP" THEN GOTO 1340
1300 S(N+1)=S(N-1)
1310 S(N-1)=S(N)
1320 S(N)=S(N+1)
1330 GOTO 190
1340 IF A$<>"OVER" THEN GOTO 1380
1350 N=N+1
1360 S(N)=S(N-2)
1370 GOTO 190
1380 IF A$<>">R" THEN GOTO 1430
1390 M=M+1
1400 R(M)=S(N)
1410 N=N-1
1420 GOTO 190
1430 IF A$<>"R>" THEN GOTO 1480
1440 N=N+1
1450 S(N)=R(M)
1460 M=M-1
1470 GOTO 190
1480 IF A$<>"R@" THEN GOTO 1520
1490 N=N+1
1500 S(N)=R(M)
1510 GOTO 190
1520 REM **************CONTROL STRUCTURES **************
1530 IF A$<>"=" THEN GOTO 1600
1540 N=N-1
1550 IF S(N)=S(N+1) THEN GOTO 1580
1560 S(N)=0
1570 GOTO 190
1580 S(N)=1
1590 GOTO 190
1600 IF A$<>">" THEN GOTO 1670
1610 N=N-1
1620 IF S(N)>S(N+1) THEN GOTO 1650
1630 S(N)=0
1640 GOTO 190
1650 S(N)=1
1660 GOTO 190
1670 IF A$<>"<" THEN GOTO 1740
1680 N=N-1
1690 IF S(N)"IF" THEN GOTO 1870
1750 N=N-1
1760 IF S(N+1) THEN GOTO 190
1770 FOR I=L(K) TO LO(K)-3
1780 B$=MID$(I$,I,4)
1790 IF B$="ELSE" THEN GOTO 1840
1800 IF B$="THEN" THEN GOTO 1840
1810 NEXT I
1820 PRINT "IF?"
1830 GOTO 100
1840 L(K)=I+4
1850 GOTO 190
1860 GOTO 190
1870 IF A$<>"ELSE" THEN GOTO 1890
1880 GOTO 1770
1890 IF A$<>"THEN" THEN GOTO 1910
1900 GOTO 190
1910 IF A$<>"BEGIN" THEN GOTO 1950
1920 M=M+1
1930 R(M)=L(K)
1940 GOTO 190
1950 IF A$<>"UNTIL" THEN GOTO 2030
1960 N=N-1
1970 IF S(N+1) THEN GOTO 2010
1980 IF S(N+1) THEN GOTO 190
1990 L(K)=R(M)
2000 GOTO 190
2010 M=M-1
2020 GOTO 190
2030 IF A$<>"DO" THEN GOTO 2120
2040 M=M+1
2050 R(M)=L(K)
2060 M=M+1
2070 R(M)=S(N-1)
2080 M=M+1
2090 R(M)=S(N)
2100 N=N-2
2110 GOTO 190
2120 IF A$<>"LOOP" THEN GOTO 2190
2130 R(M)=R(M)+1
2140 IF R(M-1)>R(M) THEN GOTO 2170
2150 M=M-3
2160 GOTO 190
2170 L(K)=R(M-2)
2180 GOTO 190
2190 REM ********* CONSTANTS **************
2200 IF A$<>"PI" THEN GOTO 2240
2210 N=N+1
2220 S(N)=3.14159
2230 GOTO 190
2240 IF A$<>"0" THEN GOTO 2280
2250 N=N+1
2260 S(N)=0
2270 GOTO 190
2280 IF A$<>"STOP" THEN GOTO 2300
2290 STOP
2300 REM ********* NUMBER **********
2310 N=N+1
2320 S(N)=VAL(A$)
2330 GOTO 190
2340 END