Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP Posting-Version: version B 2.10 5/3/83; site aplvax.UUCP Path: utzoo!watmath!clyde!burl!hou3c!hocda!houxm!houxz!vax135!floyd!cmcl2!seismo!rlgvax!cal-unix!umcp-cs!aplvax!lwt1 From: lwt1@aplvax Newsgroups: net.sources Subject: UNIX FORTH for the PDP11 (part 7 of 7) Message-ID: <648@aplvax.UUCP> Date: Fri, 8-Jun-84 15:57:19 EDT Article-I.D.: aplvax.648 Posted: Fri Jun 8 15:57:19 1984 Date-Received: Sun, 10-Jun-84 00:15:08 EDT Organization: JHU/Applied Physics Lab, Laurel, MD Lines: 685 Here is part 7 of the source for FORTH for the PDP-11. Delete everything thru the "-- cut here --" line, and extract with 'sh': sh part1 part2 ... part7 where 'part?' are whatever you've named the files. Note the copyright notice at the end of README. Please let us know how things go. While we can't support this software, we'll be posting bug fixes/upgrades to net.sources as time permits. VAX-FORTH should be 'forth'-coming {yuk-yuk} within a couple of weeks. Have fun! -Lloyd W. Taylor ... seismo!umcp-cs!aplvax!lwt1 ---I will have had been there before, soon--- ---------------------------------- cut here ---------------------------------- echo x - SYS:SRC cat >SYS:SRC <<'+E+O+F' ( HIGH LEVEL FORTH DEFINITIONS ) HEX ( SYSTEM CONSTANTS AND VARIABLES ) inbuf CONSTANT TIB ( START OF TEXT INPUT BUFFER ) inbuf CONSTANT SP0 ( TOP OF PARAMETER STACK AREA ) dp CONSTANT DP ( CURRENT DICTIONARY POINTER ) in CONSTANT >IN ( TEXT SCANNER ) initvocab CONSTANT INITVOCAB ( INITIAL FORTH VOCABULARY ) VARIABLE WRN ( ENABLE 'NOT UNIQUE' WARNINGS ) VARIABLE STATE ( INTERPRETATION STATE ) VARIABLE BASE ( BASE HEX ) VARIABLE CURRENT ( CURRENT VOCABULARY ) VARIABLE CONTXT ( CONTEXT VOCABULARY ) VARIABLE CLUE ( USED FOR COMPILING LEAVE ) 0 CONSTANT STDIN ( STANDARD INPUT FILE DESCRIPTOR ) 1 CONSTANT STDOUT ( STANDARD OUTPUT FILE DESCRIPTOR ) 0A CONSTANT EOL ( END OF LINE ) -1 CONSTANT TRUE ( TRUE ) 0 CONSTANT FALSE ( FALSE ) ( CODE EXTENSIONS: THESE ARE LOW LEVEL WORDS THAT MAY BE CANDIDATES ) ( FOR REWRITING AS CODE DEFINTIONS. ) : ?DUP DUP IF DUP THEN ; ( N --- N N0 ) : -ROT ROT ROT ; ( N1 N2 N3 --- N3 N1 N2 ) : * UM* DROP ; ( N1 N2 --- N1*N2 ) ( SIGNED MULTIPLY ) : 2DUP OVER OVER ; ( N1 N2 --- N1 N2 N1 N2 ) : S->D DUP 0< ; ( N1 --- DL DH ) ( SIGN EXTEND ) : +- 0< IF NEGATE THEN ; ( N1 N2 --- SIGN[N2]*N1 ) : D+- 0< IF DNEGATE THEN ; ( D1L D1H N1 --- D2L D2H ) : ABS DUP +- ; ( N --- |N| ) : DABS DUP D+- ; ( D --- |D| ) : 2DROP DROP DROP ; ( N1 N2 --- ) : 0> 0 > ; ( N --- T/F ) : MAX 2DUP < IF SWAP THEN DROP ; ( N1 N2 --- MAX[N1,N2] ) : MIN 2DUP > IF SWAP THEN DROP ; ( N1 N2 --- MIN[N1,N2] ) : <> = NOT ; ( N1 N2 --- T/F ) ( UNSIGNED MULTIPLCATION AND DIVISITON OPERATORS ) : UM*M ( UL UH MUL --- UL' UH' ) SWAP OVER UM* DROP >R UM* 0 R> D+ ; : M/MMOD ( DL DH DIV --- REM QUOTL QUOTH ) >R 0 R@ UM/ R> SWAP >R UM/ R> ; : UM/MOD ( DL DH DIV --- REM QUOT ) M/MMOD DROP ; ( SIGNED MULTIPLICATION AND DIVISION OPERATORS ) : /MOD ( N1 DIV --- REM QUOT ) >R S->D R> M/ ; : / ( N DIV --- DIVIDEND ) /MOD SWAP DROP ; : MOD ( N DIV --- MOD ) /MOD DROP ; : */MOD ( N MUL DIV --- REM QUOT ) >R M* R> M/ ; : */ ( N MUL DIV --- QUOT ) */MOD SWAP DROP ; : DEPTH ( --- N ) ( RETURN DEPTH OF STACK ) ( IN WORDS NOT COUNTING N. ) @SP SP0 SWAP - 2/ ; : PICK ( N1 --- N2 ) ( N2 IS A COPY OF THE ) ( N1TH STACK ITEM NOT COUNTING N1. ) ( 0 PICK IS EQUIVALENT TO DUP. ) 2* @SP + 2+ @ ; : FILL ( ADDR N BYTE --- ) SWAP ?DUP IF >R OVER C! DUP 1+ R> 1- CMOVE ELSE 2DROP THEN ; : CMOVE> ( ADDR1 ADDR2 U --- ) ( MOVE U BYTES ) ( FROM ADDR1 TO ADDR2. STARTS MOVING ) ( HIGH ADDRESSED CHARACTERS FIRST. ) ?DUP IF DUP >R + 1- SWAP DUP R> + 1- DO I C@ OVER C! 1- -1 +LOOP ELSE DROP THEN DROP ; : ROLL ( <'N' VALUES> N --- <'N' VALUES> ) ( THE NTH STACK ITEM NOT COUNTING ) ( N ITSELF IS TRANSFERRED TO THE ) ( TOP OF THE STACK, MOVING THE RE-) ( MAINING VALUES INTO THE VACATED ) ( POSITION. 0 ROLL IS A NOP. ) DUP >R PICK @SP DUP 2+ R> 1+ 2* CMOVE> DROP ; : TOGGLE ( ADDR BITS --- ) ( TOGGLE THE IN- ) ( DICATED BITS AT ADDR. ) OVER @ XOR SWAP ! ; : 2! ( DL DH ADDR --- ) ( M[ADDR]<--DH, ) ( M[ADDR+2]<--DL. ) SWAP OVER ! 2+ ! ; : 2@ ( ADDR --- DL DH ) ( DH<--M[ADDR], ) ( DL<--M[ADDR+2]. ) DUP 2+ @ SWAP @ ; : HEX 10 BASE ! ; ( SET BASE TO HEX ) : DECIMAL A BASE ! ; ( SET BASE TO DECIMAL ) : OCTAL 8 BASE ! ; ( SET BASE TO OCTAL ) ( COMPILING WORDS ) : HERE DP @ ; ( --- ADDR ) : PAD HERE 50 + ; ( --- ADDR ) : LATEST CURRENT @ @ ; ( --- ADDR ) ( RETURNS ADDR OF MOST ) ( RECENTLY COMPILED NAME FIELD. ) : ALLOT DP +! ; ( BYTECOUNT --- ) ( ALLOT DICTIONARY ) : , HERE ! 2 ALLOT ; ( WORD --- ) ( ADD TO DICTIONARY ) : IMMEDIATE LATEST 80 TOGGLE ; ( --- ) ( MAKE MOST RECENTLY COM- ) ( PILED WORD IMMEDIATE. ) : SMUDGE LATEST 40 TOGGLE ; ( --- ) ( SMUDGE MOST RECENTLY ) ( COMPILED WORD. ) : COMPILE R> DUP @ , 2 + >R ; : MARK ( --- ADDR ) ( SOURCE OF FORWARD ) ( BRANCH. ) HERE 2 ALLOT ; : >RESOLVE ( ADDR --- ) ( RESOLVE FORWARD ) ( BRANCH. ) HERE SWAP ! ; : >>RESOLVE ( OLDLINK --- ) ( RESOLVE A CHAIN ) ( OF FORWARD BRANCHES. ) HERE SWAP BEGIN DUP WHILE OVER SWAP DUP @ -ROT ! REPEAT 2DROP ; : IF ( --- ADDR ) COMPILE ?BRANCH >MARK ; IMMEDIATE METASMUDGE : THEN ( ADDR --- ) >RESOLVE ; IMMEDIATE METASMUDGE : ELSE ( ADDR --- ADDR' ) COMPILE BRANCH >MARK SWAP >RESOLVE ; IMMEDIATE METASMUDGE : BEGIN ( --- ADDR ) MARK ; IMMEDIATE METASMUDGE : REPEAT ( ADDR1 ADDR2 --- ) COMPILE BRANCH SWAP RESOLVE ; IMMEDIATE METASMUDGE : SEL 0 ; IMMEDIATE METASMUDGE : << ( OLDLINK --- OLDLINK ) COMPILE DUP ; IMMEDIATE METASMUDGE : => ( --- IFADDR ) COMPILE ?BRANCH >MARK COMPILE DROP ; IMMEDIATE METASMUDGE : ==> ( --- IFADDR ) COMPILE = COMPILE ?BRANCH >MARK COMPILE DROP ; IMMEDIATE METASMUDGE : >> ( OLDLINK IFADDR --- NEWLINK ) COMPILE BRANCH SWAP , >RESOLVE HERE 2- ; IMMEDIATE METASMUDGE : ENDSEL ( OLDLINK --- ) COMPILE DROP >>RESOLVE ; IMMEDIATE METASMUDGE ( THE CODE WORDS [DO], [LOOP], AND [+LOOP] IMPLEMENT FORTH-83 DO..LOOPS. ) ( [LEAVE] IS A FORTH-83 LEAVE. CLUE IS USED TO IMPLEMENT LEAVE. ) : DO ( --- CLUE HERE ) COMPILE (DO) CLUE @ 0 CLUE ! >RESOLVE CLUE ! ; IMMEDIATE METASMUDGE : +LOOP ( CLUE HERE --- ) COMPILE (+LOOP) >RESOLVE CLUE ! ; IMMEDIATE METASMUDGE : LEAVE ( --- ) COMPILE (LEAVE) HERE CLUE @ , CLUE ! ; IMMEDIATE METASMUDGE : EXIT ( --- ) ( EXIT THE CURRENT ) ( COLON DEFINTION. CAN'T BE ) ( USED INSIDE A LOOP. ) R> DROP ; : [ 0 STATE ! ; IMMEDIATE METASMUDGE : ] 1 STATE ! ; : ( 29 WORD DROP ; IMMEDIATE METASMUDGE ( I/O WORDS: MOST OF THE I/O IS WRITTEN IN ASSEMBLY LANGUAGE ) VARIABLE OUTTABLE ( TABLE OF FILE DESCRIPTORS USED ) ( BY TYPE. ) STDOUT OUTTABLE ! 0 , 0 , 0 , ( ZERO INDICATES NO FILE ) : FOREACHOUTPUT ( --- ADDR2 ADDR1 ) ( RETURNS UPPER) ( AND LOWER ADDRESSES OF OUTPUT TABLE) ( IN FORMAT SUITABLE FOR DO. ) OUTTABLE 8 + OUTTABLE ; : OUTPUT ( FD --- ) ( ADD THE FILE DESCRIP- ) ( TOR TO THE OUTPUT TABLE IF THERE IS) ( ROOM. ) FOREACHOUTPUT DO I @ 0= IF DUP I ! LEAVE THEN 2 +LOOP DROP ; : SILENT ( FD --- ) ( DELETE THE FILE DES- ) ( CRIPTOR FROM THE OUTPUT TABLE. ) FOREACHOUTPUT DO DUP I @ = IF 0 I ! THEN 2 +LOOP DROP ; : TYPE ( ADDR COUNT --- ) ( SEND COUNT ) ( BYTES TO EACH FILE IN THE OUTPUT) ( TABLE. ) FOREACHOUTPUT DO I @ ?DUP IF >R 2DUP R> WRITE DROP THEN 2 +LOOP 2DROP ; : EMIT ( CHAR --- ) ( SEND CHARACTER TO ) ( STDOUT. ) @SP 1 TYPE DROP ; : CR ( --- ) ( SEND NEWLINE CHARACTER ) EOL EMIT ; : FQUERY ( FD --- ACTCOUNT ) ( READ ONE ) ( LINE, UP TO 120 CHARACTERS, FROM ) ( INDICATED FILE. ACTCOUNT IS ) ( ACTUAL NUMBER OF CHARACTERS READ.) ( WILL BE ZERO ON END OF FILE. ) 0 >IN ! TIB 78 FEXPECT ; : COUNT ( ADDR --- ADDR+1 LEN ) DUP 1+ SWAP C@ ; : ALIGN ( ADDR --- ADDR' ) ( FORCE WORD ) ( ALIGNMENT OF AN ADDRESS. ) 1+ 2/ 2* ; : ,WORD ( DEL --- ) ( ADD TEXT DELIMITED BY ) ( DEL INTO DICTIONARY. ) WORD C@ 1+ ALIGN ALLOT ; : (.") ( --- ) R> COUNT 2DUP TYPE + ALIGN >R ; : ." COMPILE (.") 22 ,WORD ; IMMEDIATE METASMUDGE FORTH : ." META (.") FORTH 22 WORD DUP COUNT + ALIGN SWAP DO I @ HOST , 2 +LOOP ; HOST-->META : SPACE ( --- ) ( EMIT SPACE ) 20 EMIT ; : SPACES ( COUNT --- ) 0 MAX ?DUP IF 0 DO SPACE LOOP THEN ; : -TRAILING ( ADDR N1 --- ADDR N2 ) ( THE CHAR- ) ( ACTER COUNT OF A STRING BEGINNING ) ( AT ADDR IS ADJUSTED TO REMOVE TRAIL-) ( ING BLANKS. IF N1 IS ZERO, THEN N2 ) ( IS ZERO. IF THE ENTIRE STRING CON- ) ( SISTS OF SPACES, THEN N2 IS ZERO. ) DUP IF DUP 0 DO 2DUP + 1- C@ 20 - IF LEAVE ELSE 1- THEN LOOP THEN ; : STRING ( ADDR[COUNTED_STRING] --- ) ( ADDR[UNIX_STRING ) COUNT DUP >R PAD SWAP CMOVE 0 PAD R> + C! PAD ; : " ( --- ADDR[STRING] ) 22 WORD STRING ; : ("") ( --- ADDR[STRING] ) R> DUP COUNT + ALIGN >R STRING ; : "" COMPILE ("") 22 ,WORD ; IMMEDIATE METASMUDGE ( DEFINING WORDS ) : CFIELD ( NFA --- CFA ) 6 + ; : NFIELD ( CFA --- NFA ) 6 - ; : -IMM ( NFA --- CFA N ) ( GIVEN A NAME ) ( FIELD ADDRESS, CONVERTS TO CODE ) ( FIELD ADDRESS AND RETURNS A FLAG ) ( N WHICH IS -1 IF THE WORD IS NON-) ( IMMEDIATE AND 1 IF THE WORD IS ) ( IMMEDIATE. ) DUP CFIELD -1 ROT C@ 80 AND IF NEGATE THEN ; : FIND ( ADDR[NAME] --- ADDR2 N ) ( TRIES ) ( TO FIND NAME IN THE DICTIONARY. ) ( ADDR2 IS ADDR[NAME] AND N IS 0 IF ) ( NOT FOUND. IF THE NAME IS FOUND, ) ( ADDR2 IS THE CFA. N IS -1 IF THE ) ( WORD IS NON-IMMEDIATE AND 1 IF IT ) ( IS IMMEDIATE. ) DUP CONTXT @ @ (FIND) ( LOOKUP IN CONTEXT VOCABULARY ) ?DUP IF ( ADDR[NAME] NFA ) SWAP DROP -IMM ELSE DUP LATEST (FIND) ( LOOKUP IN CURRENT VOCABULARY ) ?DUP IF SWAP DROP -IMM ELSE 0 ( NOT FOUND ) THEN THEN ; : ' ( --- 0 <> CFA ) ( MOVES NEXT ) ( WORD IN INPUT STREAM TO HERE ) ( AND LOOKS UP IN CONTEXT AND ) ( CURRENT VOCABULARIES. RETURNS ) ( CFA IF FOUND, ZERO OTHERWISE. ) HERE 4 20 FILL ( BLANK HERE AREA ) 20 WORD FIND 0= IF DROP 0 THEN ; : HEADER ( --- ) ( CREATE DICTIONARY ) ( HEADER FOR NEXT WORD IN ) ( INPUT STREAM. ) ' IF WRN @ IF HERE COUNT TYPE ." isn't unique" CR THEN THEN HERE 4 ALLOT LATEST , CURRENT @ ! ; : CALL ( --- ) ( COMPILE OPCODE FOR ) ( JSR IAR,*$--- ) 091F , ; : : CURRENT @ CONTXT ! ( SET CONTEXT TO CURRENT ) HEADER CALL COMPILE (:) ] SMUDGE ; : ; COMPILE (;) SMUDGE 0 STATE ! ; IMMEDIATE METASMUDGE : VARIABLE HEADER CALL COMPILE (VARIABLE) 0 , ; : CONSTANT HEADER CALL COMPILE (CONSTANT) , ; : 2VARIABLE VARIABLE 0 , ; : DOES> R> LATEST CFIELD 4 + ! ; : CREATE HEADER CALL COMPILE (DOES>) 0 , DOES> ; : VOCABULARY CREATE HERE 2+ , LATEST , DOES> @ CONTXT ! ; : DEFINITIONS CONTXT @ CURRENT ! ; : FORTH INITVOCAB CONTXT ! ; IMMEDIATE ( FORMATTED OUTPUT ) VARIABLE HLD : HOLD ( CHAR --- ) ( ADD CHARACTER TO ) ( FRONT OF STRING POINTED TO BY ) ( HLD. ) -1 HLD +! HLD @ C! ; : <# ( --- ) PAD HLD ! ; : #> ( DL DH --- ADDR COUNT ) 2DROP HLD @ PAD OVER - ; : SIGN ( SIGN --- ) 0< IF 2D HOLD THEN ; : # ( DL DH --- DL' DH' ) BASE @ M/MMOD ROT 9 OVER < IF 7 + THEN 30 + HOLD ; : #S ( DL DH --- 0 0 ) BEGIN # 2DUP OR 0= UNTIL ; : D.R ( DL DH FILEDSIZE --- ) >R SWAP OVER DABS <# #S ROT SIGN #> R> OVER - SPACES TYPE ; : ZEROES ( N --- ) ( EMIT N ZEROES ) 0 MAX ?DUP IF 0 DO 30 EMIT LOOP THEN ; : D.LZ ( DL DH FIELDSIZE --- ) >R SWAP OVER DABS <# #S ROT SIGN #> R> OVER - ZEROES TYPE ; : D. ( DL DH --- ) 0 D.R SPACE ; : .R >R S->D R> D.R ; ( N FIELDSIZE --- ) : . ( N --- ) S->D D. ; : U.R 0 SWAP D.R ; ( N FIELDSIZE --- ) : U.LZ 0 SWAP D.LZ ; ( N FIELDSIZE --- ) : U. 0 D. ; ( N --- ) : ? @ . ; ( ADDR --- ) : U? @ U. ; ( ADDR --- ) ( UTILITIES ) : [COMPILE] ' , ; IMMEDIATE METASMUDGE : ['] ' COMPILE (LITERAL) , ; IMMEDIATE METASMUDGE : LITERAL COMPILE (LITERAL) , ; IMMEDIATE METASMUDGE : .( 29 WORD COUNT TYPE CR ; IMMEDIATE METASMUDGE : DUMP CR FFFF 0 <# #S #> SWAP DROP -ROT FF 0 <# #S #> SWAP DROP -ROT OVER + SWAP DO I 2 PICK U.LZ ." :" SPACE I 8 + I DO I C@ OVER U.LZ SPACE LOOP 4 SPACES I 8 + I DO I C@ DUP 20 < OVER 7E > OR IF DROP 2E THEN EMIT LOOP CR 8 +LOOP 2DROP ; : FORGET ( --- ) ( DELETE THE NEXT WORD ) ( IN THE INPUT STREAM FROM THE COM- ) ( PILATION VOCABULARY. ) HERE 4 20 FILL 20 WORD LATEST (FIND) ?DUP IF DUP DP ! 4 + @ CURRENT @ ! ELSE HERE COUNT TYPE ." ?" CR THEN ; ( OPERATING SYSTEM SUPPORT WORDS ) : DIGIT ( CHR --- N TRUE FALSE ) 30 - DUP 9 > OVER 11 < AND IF DROP FALSE ELSE DUP 9 U> IF 7 - THEN DUP BASE @ 1- U> IF DROP FALSE ELSE TRUE THEN THEN ; : CONVERT ( DL DH ADDR1 --- DL' DH' ADDR2 ) ( CONVERT CHARACTERS TO NUMBERS ) ( STARTING AT ADDR1 ACCUMULATING) ( IN D. ADDR2 IS THE ADDRESS OF ) ( THE FIRST UNCONVERTIBLE CHAR. ) >R BEGIN R> 1+ DUP >R C@ DIGIT ( TRY TO CONVERT NEXT DIGIT ) WHILE >R BASE @ UM*M R> 0 D+ REPEAT R> ; : NUMBER ( ADDR --- N TRUE FALSE ) DUP 1+ C@ 2D = DUP >R - ( SAVE SIGN ON RETURN STACK ) 0 0 ROT CONVERT C@ 20 = IF ( IF SUCCESSFUL ) DROP R> +- TRUE ( TRUNCATE, APPLY SIGN, RETURN TRUE ) ELSE 2DROP R> DROP FALSE ( ELSE RETURN FALSE ) THEN ; : ?STACK ( --- T/F ) ( RETURNS TRUE ) ( ON STACK UNDERFLOW. ) @SP SP0 > ; : CHUCKBUF ( --- ) ( FLUSH REST OF INPUT LINE ) TIB >IN @ + BEGIN DUP C@ EOL <> WHILE 1+ REPEAT TIB - >IN ! ; : ENDINTERP ( --- ) ( RESET STACK POINTER AND ) ( FLUSH REST OF INPUT LINE. ) SP0 !SP CHUCKBUF ; : INTERPRET ( --- ) BEGIN HERE 4 20 FILL 20 WORD C@ WHILE ( WHILE NOT AT END OF LINE ) HERE FIND ?DUP IF STATE @ + IF EXECUTE ELSE , THEN ELSE NUMBER IF STATE @ IF COMPILE (LITERAL) , THEN ELSE HERE COUNT TYPE ." ?" CR ENDINTERP THEN THEN ?STACK IF ." Stack empty" CR ENDINTERP THEN REPEAT ; : FLOAD ( ADDR[UNIX_STRING] --- ) 0 OPEN DUP 0< IF DROP ." can't open" CR ELSE >R BEGIN R@ FQUERY WHILE INTERPRET REPEAT R> CLOSE CHUCKBUF THEN ; : QUIT ( --- ) RESET 0 STATE ! ( RESET RETURN STACK; INTERPRET STATE ) BEGIN CR STDIN FQUERY WHILE INTERPRET STATE @ 0= IF ." OK" THEN REPEAT CR TERMINATE ; : ABORT ( --- ) SP0 !SP QUIT ; : ABORT" ( T/F --- ) ( PRINTS MESSAGE AND ) ( ABORTS IF FLAG IS TRUE. ) COMPILE ?BRANCH >MARK COMPILE (.") 22 ,WORD COMPILE ABORT >RESOLVE ; IMMEDIATE METASMUDGE ( INITIALIZATION CODE AND STARTUP CODE ) ' ABORT 4 + vector 2+ ! ( BACKPATCH INTERRUPT ROUTINE ) HERE 2 ! ( BACKPATCH STARTING JUMP ) MOV inbuf $ PSP REG ( INITIALIZE PSP ) 30 TRAP 2 , 1 , ( IGNORE INTERRUPT SIGNALS ) ROR 0 REG BCS 1 FWD ( SKIP IF INTERRUPTS ARE ALREADY IGNORED ) 30 TRAP 2 , vector , ( CATCH INTERRUPTS ) 1 L: MOV SP )+ 0 REG ( R0 HAS ARGUMENT COUNT ) ASL 0 REG ( R0 HAS BYTE COUNT ) ADD 0 REG SP REG ( POP ARGUMENTS ) TST SP )+ ( POP NULL POINTER; SP NOW HAS ENVIRONMENT ) ( POINTER USED BY EXEC CALLS ) MOV SP REG rsp0 *$ ( SAVE RETURN STACK POINTER FOR USE BY QUIT ) ( AND EXEC CALL ) MOV HERE 4 + $ IAR REG ( TRICKY; IAR POINTS TO HIGH LEVEL STARTUP ) NEXT ( EXECUTE FORTH ) ( HIGH LEVEL STARTUP CODE ) ] HEX TRUE WRN ! 0 CLUE ! FORTH DEFINITIONS CR ." unix-FORTH, version 2.1" ABORT [ ( INITILIZE VARIABLES AT COMPILE TIME ) HERE DP ! ( INITIAL DP ) OBJLINK FORTH @ HOST initvocab ! ( INITIAL VOCABULARY ) +E+O+F