UNIX FORTH for the VAX (part 4 of 8)
lwt1 at aplvax.UUCP
lwt1 at aplvax.UUCP
Sat Jun 23 04:43:30 AEST 1984
Here is part 4 of 8 of the source for FORTH for the VAX.
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.
Have fun!
-John Hayes
Johns Hopkins University
Applied Physics Laboratory
... seismo!umcp-cs!aplvax!lwt1
---------------------------------- 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. )
BEGIN
DUP WHILE
DUP @ HERE ROT !
REPEAT DROP ;
: 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
: OTHERWISE ( --- ) ( [OPTIONALLY] COMPILE )
( AN OTHERWISE CASE. )
COMPILE DUP ; 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. IN THIS )
( VERSION, ONLY ONE LEAVE IS ALLOWED PER LOOP LEVEL. )
: 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@ ;
: ,WORD ( DEL --- ) ( ADD TEXT DELIMITED BY )
( DEL INTO DICTIONARY. )
WORD C@ 1+ ALLOT ;
: (.") ( --- )
R> COUNT 2DUP TYPE + >R ;
: ."
COMPILE (.") 22 ,WORD ; IMMEDIATE METASMUDGE
FORTH : ."
META (.") FORTH
22 WORD COUNT DUP HOST C,
OVER + SWAP DO
I FORTH C@ HOST C,
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 + >R STRING ;
: ""
COMPILE ("") 22 ,WORD ; IMMEDIATE METASMUDGE
( DEFINING WORDS )
: CFIELD ( NFA --- CFA )
8 + ;
: NFIELD ( CFA --- NFA )
8 - ;
: -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 6 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 6 ALLOT LATEST , CURRENT @ ! ;
: :
CURRENT @ CONTXT ! ( SET CONTEXT TO CURRENT )
HEADER COMPILE (:) ] SMUDGE ;
: ;
COMPILE (;) SMUDGE 0 STATE ! ; IMMEDIATE METASMUDGE
: VARIABLE
HEADER COMPILE (VARIABLE) 0 , ;
: CONSTANT
HEADER COMPILE (CONSTANT) , ;
: 2VARIABLE
VARIABLE 0 , ;
: DOES>
R> LATEST CFIELD 2+ ! ;
: CREATE
HEADER 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 6 20 FILL
20 WORD LATEST (FIND) ?DUP
IF DUP DP ! 6 + @ 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 6 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
( BACKPATCH )
' ABORT 2+ vector 4 + ! ( PATCH INTERRUPT ROUTINE )
HERE 4 ! ( PATCH JUMP TO STARTUP CODE )
( STARTUP CODE )
MOVZWL inbuf W$ PSP REG ( INITIAL PSP )
PUSHL 1 L$ ( SIG_IGN )
PUSHL 2 L$ ( SIGINT )
CALLS 2 L$ _SIGNAL *$ ( DISABLE INTERRUPTS )
BLBS 0 REG 1 FWD ( BRANCH IF INTERRUPS ALREADY IGNORED )
PUSHAL vector *$ ( PUSH ADDRESS OF INTERRUPT ROUTINE )
PUSHL 2 L$ ( SIGINT )
CALLS 2 L$ _SIGNAL *$ ( CATCH SIGNALS )
1 L: MOVL SP ) 0 REG
INCL 0 REG INCL 0 REG
MOVAL 0 [] SP ) rsp0 *$ ( SAVE ENVIRONMENT POINTER )
MOVZWL HERE 8 + W$ IAR REG ( TRICKY; INITIALIZE IAR )
JMP NEXT REL
( HIGH LEVEL STARTUP CODE )
] HEX TRUE WRN ! 0 CLUE !
FORTH DEFINITIONS
CR ." VAX FORTH, version 2.0"
CR ." (c) 1984 JHU/Applied Physics Lab"
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