UNIX FORTH for the PDP11 (part 7 of 7)
lwt1 at aplvax
lwt1 at aplvax
Sat Jun 9 05:57:19 AEST 1984
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 N <OR> 0 )
: -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 ) ( USED AS DESTINATION )
( OF BACKWARD BRANCH. )
HERE ;
: <RESOLVE ( ADDR --- ) ( RESOLVE BACKWARD )
( BRANCH. )
, ;
: >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
: UNTIL ( ADDR --- )
COMPILE ?BRANCH <RESOLVE ; IMMEDIATE METASMUDGE
: AGAIN ( ADDR --- )
COMPILE BRANCH <RESOLVE ; IMMEDIATE METASMUDGE
: WHILE ( --- ADDR )
COMPILE ?BRANCH >MARK ; IMMEDIATE METASMUDGE
: REPEAT ( ADDR1 ADDR2 --- )
COMPILE BRANCH SWAP <RESOLVE >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 ! <MARK ; IMMEDIATE METASMUDGE
: LOOP ( CLUE HERE --- )
COMPILE (LOOP) <RESOLVE
CLUE @ >>RESOLVE
CLUE ! ; IMMEDIATE METASMUDGE
: +LOOP ( CLUE HERE --- )
COMPILE (+LOOP) <RESOLVE
CLUE @ >>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 <OR> 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 <OR> 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
More information about the Comp.sources.unix
mailing list