On Wednesday, September 28, 2022 at 8:23:05 AM UTC-4, none albert wrote:
At the Dutch Forth Chapter we have a few of the FORML proceedings.
and Forth Rochester conference proceedings. 1)
They seem not available. You could buy an antiquary 1981 FORML
in amazon for 200 dollar. If you buy it, then the last item is
gone.
We have donated most books owned by the chapter to a University
library, with the outcome that after a mere 5 years they disappeared.
Is this material on the verge of being lost?
In particular I'm chasing the original Basic compiler published
by Chuck Moore himself in FORML 1981, to compare it with
the Perry version.
Groetjes Albert
1) (surviving in banana boxes).
--
"in our communism country Viet Nam, people are forced to be
alive and in the western country like US, people are free to
die from Covid 19 lol" duc ha
albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst
Hi Albert,
I don't know where I found this years ago, but I have it on my drive.
At some point I wanted to understand what it would take to make
a script language for non Forth speakers but never made one.
I think it is "based" on Chucks work but I can't be sure.
\ 1 BASIC compiler 06Feb84map
ONLY FORTH ALSO DEFINITIONS
: .R RP0 @ RP@ ?DO I @ 2- @ >NAME .ID 2 +LOOP ;
VOCABULARY ARITHMETIC ARITHMETIC ALSO DEFINITIONS
VOCABULARY LOGIC
VOCABULARY INPUTS
VOCABULARY OUTPUTS
: [ ASCII ] WORD DROP ; IMMEDIATE
: GET BL WORD NUMBER DROP ;
CREATE #S 130 ALLOT
FORTH DEFINITIONS
1 2 +THRU ( precedence and variables )
: BASIC [ ARITHMETIC ] 0 #S 2+ #S 2! START ALSO ; IMMEDIATE
ARITHMETIC DEFINITIONS
3 7 +THRU ( BASIC )
: ( 10 #( +! ; IMMEDIATE
: ; [ n] . ; 1 PRECEDENCE ;
FORTH DEFINITIONS
\ 2 Precedence 06Feb84map
VARIABLE ADDRESS VARIABLE #(
: ) -10 #( +! #( @ 0< ABORT" Unmatched )" ; IMMEDIATE
: DEFER ( a n a n - a n) #( @ +
BEGIN 2OVER NIP OVER >= WHILE 2SWAP DROP , REPEAT ;
: PRECEDENCE
( n) >IN @ ' >R >IN ! CONSTANT R> ,
IMMEDIATE DOES> 2@ DEFER ;
: RPN ( n) 0 1 DEFER 2DROP #( @ OR ABORT" Syntax" ;
: ?IGNORE #( @ IF 0 1 DEFER 2DROP R> DROP THEN ;
: NOTHING ;
: START ( - n) 0 #( ! 0 ADDRESS ! ['] NOTHING 0 ARITHMETIC ;
\ 3 Variables 06Feb84map
: INTEGER
VARIABLE IMMEDIATE
DOES> [COMPILE] LITERAL
ADDRESS @
IF ADDRESS OFF
ELSE COMPILE @ THEN ;
: (ARRAY) ( a a)
SWAP >R 7 DEFER R> [COMPILE] LITERAL
ADDRESS @
IF ADDRESS OFF
ELSE ['] @ 7 #( @ + 2SWAP THEN ;
: [+] ( a i - a) 1- 2* + ;
: ARRAY INTEGER 1- 2* ALLOT DOES> ['] [+] (ARRAY) ;
: [*+] ( a x y - a) >R 1- OVER @ * R> + 2* + ;
: 2ARRAY ( y x)
DUP CONSTANT IMMEDIATE * 2* ALLOT
DOES> ['] [*+] (ARRAY) ;
\ 4 Statement numbers ( works at any address ) 06Feb84map
: FIND ( line# -- entry-adr )
TRUE #S @ #S 2+
?DO OVER I @ ABS = IF 2DROP I FALSE LEAVE THEN 4 +LOOP
IF 0 SWAP #S @ 2! #S @ 4 #S +! THEN ;
: RESOLVE ( n -- )
FIND DUP @ 0< ABORT" duplicated"
DUP @ NEGATE OVER ! 2+ DUP @
BEGIN ?DUP
WHILE DUP @ HERE ROT !
REPEAT HERE SWAP ! ;
: CHAIN ( n - a)
FIND LENGTH 0<
IF @ ELSE DUP @ HERE ROT ! THEN ;
: STATEMENT ( n -- )
HERE 2- @ >R -4 ALLOT RPN EXECUTE
R> RESOLVE START ;
\ 5 Branching - high level 13Mar84map
: JUMP R> @ >R ;
: CALL R> DUP @ SWAP 2+ >R >R ;
: SKIP 0= IF R> 4 + >R THEN ;
: (NEXT)
2DUP +! >R 2DUP R> @ SWAP
0< IF SWAP THEN -
0< IF 2DROP R> 2+ ELSE R> @ THEN >R ;
: [1] COMPILE 1 HERE ;
: [NEXT] COMPILE (NEXT) , ;
: (GOTO) GET COMPILE JUMP CHAIN , ;
: (RET) R> DROP ;
\ 6 BASIC 19Jul84map
: LET STATEMENT ADDRESS ON ; IMMEDIATE
: FOR [COMPILE] LET ; IMMEDIATE
: TO RPN DROP ['] [1] 0 ; IMMEDIATE
: STEP RPN DROP ['] HERE 0 ; IMMEDIATE
: NEXT STATEMENT 2DROP ['] [NEXT] 0 ADDRESS ON ; IMMEDIATE
: REM STATEMENT [COMPILE] \ ; IMMEDIATE
: DIM [COMPILE] REM ; IMMEDIATE
: STOP STATEMENT COMPILE (RET) ; IMMEDIATE
: END STATEMENT 2DROP [COMPILE] ; PREVIOUS FORTH ; IMMEDIATE
: GOTO STATEMENT (GOTO) ; IMMEDIATE
: IF STATEMENT LOGIC ; IMMEDIATE
: THEN RPN 0 COMPILE SKIP (GOTO) ; IMMEDIATE
: RETURN STATEMENT COMPILE (RET) ; IMMEDIATE
: GOSUB STATEMENT GET COMPILE CALL CHAIN , ; IMMEDIATE
\ 7 Input and Output 06Feb84map
: ASK ." ? " QUERY ;
: PUT GET SWAP ! ;
: (INPUT) COMPILE PUT ;
: (,) ( n) (.) 14 OVER - SPACES TYPE SPACE ;
OUTPUTS DEFINITIONS
: , ( n) ?IGNORE ['] (,) 1 DEFER ; IMMEDIATE
: " [COMPILE] ." 2DROP ; IMMEDIATE
INPUTS DEFINITIONS
: , ?IGNORE RPN 0 (INPUT) ADDRESS ON ; IMMEDIATE
ARITHMETIC DEFINITIONS
: PRINT STATEMENT COMPILE CR ['] (,) 1 OUTPUTS ; IMMEDIATE
: INPUT STATEMENT 2DROP COMPILE ASK ['] (INPUT) 0 INPUTS ADDRESS ON ; IMMEDIATE
\ 8 Operators 06Feb84map
LOGIC DEFINITIONS
2 PRECEDENCE <>
2 PRECEDENCE <=
2 PRECEDENCE >=
2 PRECEDENCE =
2 PRECEDENCE <
2 PRECEDENCE >
ARITHMETIC DEFINITIONS
: = ( a n) SWAP ! ; 1 PRECEDENCE =
: ** ( n n - n) 1 SWAP 1 DO OVER * LOOP * ;
6 PRECEDENCE ABS
5 PRECEDENCE **
4 PRECEDENCE *
4 PRECEDENCE /
4 PRECEDENCE */
3 PRECEDENCE +
3 PRECEDENCE -
\ 9 [ Dwyer, page 17, Program 1] ( works ) 06Feb84map
INTEGER J INTEGER K
: RUN BASIC
10 PRINT " THIS IS A COMPUTER"
20 FOR K = 1 TO 4
30 PRINT " NOTHING CAN GO"
40 FOR J = 1 TO 3
50 PRINT " WRONG"
60 NEXT J
70 NEXT K
80 END
RUN
\ 10 [ basic: branching demo ] ( works ) 06Feb84map
INTEGER J INTEGER K
: RUN BASIC
10 FOR K = 1 TO 15 STEP 3
15 LET J = J + K
20 IF K >= 8 THEN 35
25 PRINT K
30 GOTO 40
35 PRINT K , J , " SUM "
40 NEXT K
50 PRINT " DONE "
80 END
RUN
\ 11 [ basic: array demo ] ( works ) 06Feb84map
INTEGER K 9 ARRAY COORDINATE
: RUN BASIC
10 FOR K = 1 TO 9
20 LET COORDINATE K = ( 10 - K ) ** 3
40 PRINT COORDINATE K + 5
60 NEXT K
80 END
RUN
\ 12 [ basic string printing demo ] 06Feb84map
INTEGER X INTEGER Y INTEGER Z
: RUN BASIC
10 LET X = 5
20 LET Y = 7
30 PRINT X , Y
60 PRINT X , " TEST "
90 END
RUN
\ 13 [ basic program # 1 ] ( works ) 06Feb84map
INTEGER K INTEGER X 3 ARRAY Z
: RUN BASIC
10 LET Z 1 = 1
15 LET Z 2 = 22
20 LET Z 3 = 333
30 FOR K = 1 TO 3
40 LET X = Z K
50 PRINT X
60 NEXT K
80 END
RUN
\ 14 [ basic inputting demo ] 06Feb84map
INTEGER K INTEGER X INTEGER Y
: RUN BASIC
10 INPUT X , Y
20 LET K = X * Y ** 3
40 PRINT X , Y , K
80 END
RUN
\ 15 [ basic: GOSUB demo ] 19Jul84map
INTEGER K
9 ARRAY COORDINATE
: RUN BASIC
10 FOR K = 1 TO 9
20 LET COORDINATE K = 10 - K
30 GOSUB 60
40 NEXT K
50 GOTO 80
60 PRINT COORDINATE K
70 RETURN
80 END
--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)