UNIX FORTH for the VAX (part 3 of 8)

Sat Jun 23 04:42:55 AEST 1984

Here is part 3 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:ASM
cat >SYS:ASM <<'!E!O!F'

( Copyright 1984 by the Johns Hopkins University/Applied Physics Lab	)
( Free non-commercial distribution is *encouraged*, provided that: 	)
(  									)
( 	1.  This copyright notice is included in any distribution, and 	)
( 	2.  You let us know that you're using it. 			)
(  									)
( Please notify: 							)
(  									)
( 	John Hayes 							)
( 	JHU/Applied Physics Lab 					)
( 	Johns Hopkins Road 						)
( 	Laurel, MD 20707 						)
( 	[301] 953-5000 x8086 						)
(  									)
( 	Usenet:  ... seismo!umcp-cs!aplvax!lwt1 			)
(  									)
(  									)
( Unix-FORTH was developed under NASA contract NAS5-27000 for the 	)
( Hopkins Ultraviolet Telescope, a March 1986 Space Shuttle mission.  	)
( We hope to take a peek at Halley's comet!				)
(  									)
( Written entirely by Wizard-In-Residence John R. Hayes. 		)
(  									)
( * Unix is a trademark of Bell Labs. 					)
(  									)

( VAX FORTH ASSEMBLY LANGUAGE NUCLEUS ) HEX
	0 ,			( ENTRY MASK )
JMP -1 *$			( JUMP TO STARTUP CODE: WILL BE BACKPATCHED )

LABEL	rsp0 0 , 0 ,		( INITIAL VALUE OF RETURN STACK POINTER )
LABEL 	in 0 ,			( >IN: INPUT PARSER )
LABEL	initvocab 0 ,		( INITIAL FORTH VOCABULARY )
LABEL 	dp 0 ,			( END OF DICTIONARY POINTER )

	400 RAMALLOT		( 256 BYTE PARAMETER STACK )
LABEL inbuf
	78 RAMALLOT		( 120 BYTE INPUT BUFFER )

( INDIRECT THREADED CODE INNER INTERPRETER )

PRIM (:)			( CALL: SHOULD NOT BE USED IN A COLON DEF. )
 MOVW IAR REG   SP -(
 MOVW 0 REG   IAR REG

LABEL NEXT			( NEXT )
 MOVZWL IAR )+   0 REG
 MOVZWL 0 )+   1 REG
 JMP 1 )

CODE (;)			( RETURN )
 MOVZWL SP )+   IAR REG
 MOVZWL IAR )+    0 REG		( NEXT CODE REPEATED FOR SPEED )
 MOVZWL 0 )+   1 REG
 JMP 1 )

( [VARIABLE], [CONSTANT], AND [DOES>] ARE RUN TIME WORDS AND SHOULD NOT BE )
( USED IN COLON DEFINITIONS.  POINTERS TO THEIR PFA'S SHOULD BE COMPILED   )
( BY A DEFINING WORD.  THIS IS AN ALTERNATIVE TO ;CODE USED IN SOME FORTH  )
( SYSTEMS.								   )

PRIM (VARIABLE)
 MOVW 0 REG   PSP -(
 JMP NEXT REL

PRIM (CONSTANT)
 MOVW 0 )   PSP -(
 JMP NEXT REL

PRIM (DOES>)
 MOVW IAR REG   SP -(
 MOVZWL 0 )+   IAR REG
 MOVW 0 REG   PSP -(
 JMP NEXT REL

( CONTROL FLOW PRIMITIVES )

CODE (LITERAL)
 MOVW IAR )+   PSP -(
 JMP NEXT REL

CODE BRANCH
 1 L: MOVZWL IAR )   IAR REG
 JMP NEXT REL

CODE ?BRANCH
 TSTW PSP )+
 BEQL 1 BACK
 ADDW2 2 W$   IAR REG
 JMP NEXT REL

CODE EXECUTE
 MOVZWL PSP )+   0 REG
 MOVZWL 0 )+   1 REG
 JMP 1 )

CODE (DO)
 ADDW3 2 PSP X(   8000 W$   0 REG
 MOVW 0 REG   SP -(
 SUBW3 0 REG   PSP )+   SP -(
 ADDW2 2 W$   PSP REG
 JMP NEXT REL

CODE (LOOP)
 INCW SP )
 BVC 1 BACK
 ADDL2 4 L$   SP REG
 ADDW2 2 W$   IAR REG
 JMP NEXT REL

CODE (+LOOP)
 ADDW2 PSP )+   SP )
 BVC 1 BACK
 ADDL2 4 L$   SP REG
 ADDW2 2 W$   IAR REG
 JMP NEXT REL

CODE I
 ADDW3 SP )   2 SP X(   PSP -(
 JMP NEXT REL

CODE J
 ADDW3 4 SP X(   6 SP X(   PSP -(
 JMP NEXT REL

CODE (LEAVE)
 ADDL2 4 L$   SP REG
 MOVZWL IAR )   IAR REG
 JMP NEXT REL

( BASIC UNIX SYSTEM INTERFACE )

( LOW LEVEL SYSTEM CALLS )

LABEL _READ	0 ,		( ENTRY MASK )
 CHMK 3 W$
 BCC 1 FWD
 CLRL 0 REG
1 L: RET

LABEL _WRITE	0 ,		( ENTRY MASK )
 CHMK 4 W$
 BCC 1 FWD
 MNEGL 1 L$  0 REG
1 L: RET

LABEL _LSEEK	0 ,		( ENTRY MASK )
 CHMK 13 W$
 BCC 1 FWD
 CLRL 0 REG
1 L: RET

LABEL _CREAT	0 ,		( ENTRY MASK )
 CHMK 8 W$
 BCC 1 FWD
 MNEGL 1 L$   0 REG		( RETURN A -1 IF ERROR )
1 L: RET

LABEL _OPEN	0 ,		( ENTRY MASK )
 CHMK 5 W$
 BCC 1 FWD
 MNEGL 1 L$   0 REG		( RETURN -1 IF ERROR )
1 L: RET

LABEL _CLOSE	0 ,		( ENTRY MASK )
 CHMK 6 W$
 RET

LABEL _EXIT	0 , 		( ENTRY MASK )
 CHMK 1 W$			( SHOULD NEVER RETURN )
 HALT

LABEL _FORK	0 , 		( ENTRY MASK )
 CHMK 2 W$
 BGEQU 1 FWD
 MNEGL 1 L$   0 REG		( ERROR )
 RET
1 L: BLBC 1 REG   2 FWD
 CLRL 0 REG			( RETURN ZERO IF CHILD )
2 L: RET

LABEL _SIGNAL	0 ,		( ENTRY MASK )
 CHMK 30 W$
 BGEQU 1 FWD
 MNEGL 1 L$  0 REG		( ERROR )
1 L: RET

LABEL _WAIT	0 ,		( ENTRY MASK )
 CHMK 7 W$
 BGEQU 1 FWD
 MNEGL 1 L$   0 REG		( ERROR )
 RET
1 L: TSTL 4 AP X(
 BEQL 2 FWD
 MOVL 1 REG   4 AP *X(
2 L: RET

LABEL _EXECVE	0 ,		( ENTRY MASK )
 CHMK 3B W$
 HALT				( SHOULD NEVER BE EXECUTED )

EVEN				( INTERRUPT ROUTINES MUST START AT WORD ADDR )
LABEL vector 0 ,		( SIGINT INTERRUPT SERVICE ROUTINE )
 MOVZWL -1 W$   IAR REG		( MOVE ABORT TO IAR; WILL BE BACKPATCHED )
 PUSHAL vector *$		( PUSH ADDRESS OF INTERRUPT ROUTINE )
 PUSHL 2 L$			( SIGINT )
 CALLS 2 L$   _SIGNAL *$	( IGNORE INTERRUPTS )
 JMP NEXT REL 

( DATA AND CODE FOR SPAWNING OFF SUB-PROCESSES )
 LABEL STATUS 0 , 0 ,		( LONG WORD FOR RECEIVING STATUS FROM WAIT )
 LABEL NAME	622F , 6E69 , 632F , 6873 , 0 ,	( "/bin/csh" )
 LABEL 0ARG	7363 , 68 ,			( "csh" )
 LABEL 1ARG	632D , 0 ,			( "-c" )
 LABEL ARGV	0ARG , 0 , 1ARG , 0 , 0 , 0 ,	( ARGUMENT LIST )
		0 , 0 ,				( LIST TERMINATOR )

CODE SHELL			( --- )   ( SPAWN OFF INTERACTIVE SUB-SHELL )
 CLRL ARGV 4 + *$		( sh WITH NO ARGUMENTS )
0 L:				( SPAWN SUB-PROCESS; SYSTEM SHARES THIS CODE )
 CALLS 0 L$   _FORK *$		( FORK )
 TSTL 0 REG
 BNEQ 1 FWD			( BRANCH IF NOT THE CHILD PROCES )
 PUSHL rsp0 *$			( ENVIRONMENT POINTER )
 PUSHAL ARGV *$			( ADDRESS OF ARGUMENT ARRAY )
 PUSHAL NAME *$			( ADDRESS OF COMMAND NAME )
 CALLS 3 L$   _EXECVE *$	( EXEC CALL; SHOULD NOT RETURN )

1 L:
 PUSHL 1 L$			( SIG_IGN )
 PUSHL 2 L$			( SIGIGT )
 CALLS 2 L$   _SIGNAL *$	( DISABLE INTERRUPTS )
 MOVL 0 REG   2 REG		( SAVE OLD INTERRUPT ADDRESS )
 PUSHAL STATUS *$		( ADDRESS OF STATUS WORD )
 CALLS 1 L$   _WAIT *$		( WAIT )
 PUSHL 2 REG			( OLD INTERRUPT ADDRESS )
 PUSHL 2 L$			( SIGINT )
 CALLS 2 L$   _SIGNAL *$	( RESTORE OLD INTERRUPT STATE )
 JMP NEXT REL 

CODE SYSTEM			( ADDR[STRING] --- )   ( PASS NULL-TERMINATED )
				( STRING TO SHELL FOR EXECUTION.	      )
 MOVZWL 1ARG W$   ARGV 4 + *$	( MOVE POINTER TO "-c" TO ARGUMENT LIST )
 MOVZWL PSP )+   ARGV 8 + *$	( MOVE POINTER TO COMMAND STRING TO LIST )
 BRB 0 BACK			( BRANCH TO CODE TO SPAWN SUB-SHELL )

( 	I/O BUFFER AND CONTROL VARIABLES )

LABEL BLOCK	400 RAMALLOT	( 1024 BYTE INPUT BUFFER )
LABEL SIZE	0 ,		( SIZE OF BUFFER IN BYTES )
LABEL INDEX	0 ,		( CURRENT OFFSET INTO BLOCK )
LABEL FD	0 ,		( FILE DESCRIPTOR OF ASSOCIATED FILE )

( FILE POSITION TABLE : EACH SLOT HAS A 32 BIT FILE OFFSET.  FILE DES- )
( CRIPTOR IS OFFSET INTO TABLE.  THERE ARE 15 SLOTS.		       )

LABEL FILEPOS	0 , 0 ,
		0 , 0 ,
		0 , 0 ,
		0 , 0 ,
		0 , 0 ,
		0 , 0 ,
		0 , 0 ,
		0 , 0 ,
		0 , 0 ,
		0 , 0 ,
		0 , 0 ,
		0 , 0 ,
		0 , 0 ,
		0 , 0 ,
		0 , 0 ,

( SUBROUTINE GETC:  HANDLES ALL INPUT AND DOES BUFFERING  )
(	INPUT: FILE DESCRIPTOR IN R2			  )
(	OUTPUT: CHARACTER OR EOF IN R0			  )
( 	SIDE EFFECTS: R3 IS MODIFIED			  )

LABEL GETC
 CMPW 2 REG   FD REL
 BEQL 1 FWD			( SEEK IF NEW FD IS NOT SAME AS OLD FD )
 MOVW 2 REG   FD REL
 MOVW SIZE REL   INDEX REL	( INDICATE THAT BUFFER IS EMPTY )
 CLRL SP -(			( WHENCE IS START OF FILE )
 PUSHL 2 []   FILEPOS REL	( PUSH FILE POSITION )
 PUSHL 2 REG			( PUSH FILE DESCRITPTOR )
 CALLS 3 L$   _LSEEK REL	( SEEK )
1 L: MOVZWL INDEX REL   3 REG	( R3 HAS INDEX )
 CMPW 3 REG   SIZE REL
 BLSS 2 FWD			( READ FILE IF BUFFER IS EMPTY )
 PUSHL 400 L$			( PUSH BLOCK SIZE )
 PUSHL BLOCK L$			( PUSH ADDRESS OF BLOCK )
 PUSHL 2 REG			( PUSH FILE DESCRIPTOR )
 CALLS 3 L$   _READ REL		( READ )
 MOVW 0 REG   SIZE REL		( SAVE SIZE )
 CLRL 3 REG			( RESET INDEX )
2 L: CMPW 3 REG   SIZE REL
 BEQL 3 FWD			( BRANCH IF END OF FILE )
 INCL 2 []   FILEPOS REL	( UPDATE FILE POSITION )
 MOVZBL BLOCK 3 X(   0 REG	( RETURN CHARACTER )
 INCW 3 REG			( UPDATE INDEX )
 BRB 4 FWD
3 L: MNEGL 1 L$ 0 REG		( RETURN EOF: -1 )
4 L: MOVW 3 REG   INDEX REL	( SAVE INDEX )
 RSB

CODE FEXPECT			( FD ADDR COUNT --- ACTCOUNT )
 MOVZWL 2 PSP X(   4 REG	( BUFFER ADDRESS )
 MOVZWL PSP )+   5 REG		( COUNT )
 BEQL 3 FWD
1 L: MOVZWL 2 PSP X(   2 REG	( FILE DESCRIPTOR )
 JSB GETC REL			( GET NEXT CHARACTER )
 CMPW 0 REG   -1 W$
 BEQL 4 FWD			( LEAVE LOOP ON EOF )
 CMPB 0 REG    09 B$
 BNEQ 2 FWD
 MOVB 20 B$   0 REG		( CHANGE TABS TO BLANKS )
2 L: MOVB 0 REG   4 )+		( SAVE CHARACTER )
 CMPB 0 REG   0A B$
 BEQL 5 FWD			( LEAVE LOOP ON NEW LINE )
 SOBGTR 5 REG   1 BACK		( DECREMENT COUNT AND CONTINUE IF NON-ZERO )
3 L:  4 L:  5 L:
 SUBW2 PSP )+   4 REG		( COMPUTE ACTUAL NUMBER OF CHARACTERS READ )
 MOVW 4 REG   PSP )		( RETURN ACTUAL NUMBER )
 JMP NEXT REL

CODE READ			( FD ADDR COUNT --- ACTCOUNT )
 MOVZWL 2 PSP X(    4 REG	( BUFFER ADDRESS )
 MOVZWL PSP )+   5 REG		( COUNT )
 BEQL 3 FWD
1 L: MOVZWL 2 PSP X(   2 REG	( FILE DESCRIPTOR )
 JSB GETC REL			( GET NEXT CHARACTER )
 CMPW 0 REG   -1 W$
 BEQL 4 FWD			( LEAVE LOOP ON END OF FILE )
 MOVB 0 REG   4 )+		( SAVE CHARACTER )
 SOBGTR 5 REG    1 BACK 	( DECREMENT COUNT AND CONTINUE IF NON-ZERO )
3 L:  4 L:
 SUBW2 PSP )+   4 REG		( COMPUTE ACTUAL NUMBER OF CHARACTERS READ )
 MOVW 4 REG   PSP )		( RETURN ACTUAL COUNT )
 JMP NEXT REL

CODE WRITE			( ADDR COUNT FD --- ACTCOUNT )
 MOVZWL PSP )+   0 REG		( FILE DESCRIPTOR )
 MOVZWL PSP )+   SP -( 		( STACK COUNT )
 MOVZWL PSP )   SP -( 		( STACK ADDRESS )
 PUSHL 0 REG			( STACK FILE DESCRIPTOR )
 CALLS 3 L$   _WRITE REL	( WRITE )
 MOVW 0 REG PSP )		( RETURN ACTUAL COUNT )
 JMP NEXT REL

CODE SEEK			( FD OFFSETL OFFSETH --- )
 MOVW 2 PSP X(   PSP -(
 MOVL PSP )+   0 REG		( OFFSET )
 ADDW2 2 W$   PSP REG
 MOVZWL PSP )+   1 REG		( FILE DESCRIPTOR )
 CMPW 1 REG   FD REL
 BNEQ 1 FWD
 MOVW SIZE REL   INDEX REL	( IF SEEKING BUFFERED FILE, RESET BUFFER )
1 L: MOVL 0 REG   1 []  FILEPOS REL
				( SAVE NEW POSITION IN POSITION TABLE )
 CLRL SP -(			( WHENCE IS START OF FILE )
 PUSHL 0 REG			( OFFSET )
 PUSHL 1 REG			( FD )
 CALLS 3 W$   _LSEEK REL	( SEEK )
 JMP NEXT REL

CODE CREAT			( ADDR[STRING] PMODE --- FD )
 MOVZWL PSP )+   SP -(		( STACK PROTECTION MODE )
 MOVZWL PSP )   SP -(		( STACK ADDRESS OF FILE NAME STRING )
 CALLS 2 W$   _CREAT REL	( CREAT SYSTEM CALL )
 MOVW 0 REG   PSP )		( RETURN FILE DESCRIPTOR )
 BLSS 1 FWD			( SKIP IF CREATION FAILED )
 CLRL 0 [] FILEPOS REL		( SET FILE POSITION TO ZERO )
1 L: JMP NEXT REL

CODE OPEN			( ADDR[STRING] MODE --- FD )
 MOVZWL PSP )+   SP -(		( STACK MODE )
 MOVZWL PSP )   SP -(		( STACK ADDRESS OF FILE NAME )
 CALLS 2 W$   _OPEN REL		( OPEN )
 MOVW 0 REG   PSP )		( RETURN FILE DESCRIPTOR )
 BLSS 1 FWD			( SKIP IF OPEN FAILED )
 CLRL 0 []   FILEPOS REL	( RESET FILE POSITION )
1 L: JMP NEXT REL

CODE CLOSE			( FD --- )
 MOVZWL PSP )+   SP -(		( STACK FILE DESCRIPTOR )
 CALLS 1 W$   _CLOSE REL	( CLOSE )
 JMP NEXT REL

CODE TERMINATE			( --- )
 CLRL SP -(			( RETURN GOOD STATUS )
 CALLS 1 W$   _EXIT REL		( EXIT )
 JMP NEXT REL				( SHOULD NEVER BE EXECUTED )

( HIGH LEVEL UTILITIES WRITTEN IN ASSEMBLY LANGUAGE FOR SPEED )

CODE (FIND)			( ADDR[WORD] ADDR[VOCAB] --- 0 <OR> NFA )
 MOVZWL PSP )+   0 REG
 BEQL 3 FWD
 MOVZWL PSP )   1 REG
 MOVL 1 )   2 REG
1 L: BICL3 80 L$   0 )   3 REG
 CMPL 2 REG   3 REG
 BNEQ 2 FWD
 CMPW 4 1 X(   4 0 X(
 BEQL 4 FWD
2 L: MOVZWL 6 0 X(   0 REG
 BNEQ 1 BACK
3 L:
4 L: MOVW 0 REG  PSP )
 JMP NEXT REL

CODE WORD			( DEL --- ADDR )
 CLRL 1 REG
 ADDW3 inbuf W$   in REL   1 REG
 SKPC PSP )   100 W$   1 )
 MOVZWL PSP )   0 REG
 MOVZWL dp REL   2 REG
 MOVW 2 REG   PSP )
 MOVL 1 REG   3 REG
1 L: CMPB 0 REG   3 )
 BEQL 2 FWD
 CMPB 0A B$   3 )
 BEQL 3 FWD
 INCW 3 REG
 BRB 1 BACK
2 L:
3 L: SUBW2 1 REG   3 REG
 MOVB 3 REG   2 )+
 BEQL 5 FWD
4 L: MOVB 1 )+   2 )+
 SOBGTR 3 REG   4 BACK
5 L: CMPB 0A B$   1 )
 BEQL 6 FWD
 INCW 1 REG
6 L: SUBW3   inbuf W$   1 REG   in REL
 MOVB 20 B$   2 )
 JMP NEXT REL

( STACK PRIMITIVES )

CODE !
 MOVZWL PSP )+   0 REG
 MOVW PSP )+   0 )
 JMP NEXT REL

CODE !SP
 MOVZWL PSP )   PSP REG
 JMP NEXT REL

CODE +
 ADDW2 PSP )+   PSP )
 JMP NEXT REL

CODE +!
 MOVZWL PSP )+   0 REG
 ADDW2 PSP )+   0 )
 JMP NEXT REL

CODE -
 SUBW2 PSP )+   PSP )
 JMP NEXT REL

CODE -1
 MNEGW 1 W$   PSP -(
 JMP NEXT REL

CODE 0
 CLRW PSP -(
 JMP NEXT REL

CODE 0<
 CLRW 0 REG
 TSTW PSP )
 BGEQ 1 FWD
 MNEGW 1 W$   0 REG
1 L: MOVW 0 REG   PSP )
 JMP NEXT REL

CODE 0=
 CLRW 0 REG
 TSTW PSP )
 BNEQ 1 FWD
 MNEGW 1 W$   0 REG
1 L: MOVW 0 REG   PSP )
 JMP NEXT REL

CODE 1
 MOVW 1 W$   PSP -(
 JMP NEXT REL

CODE 1+
 INCW PSP )
 JMP NEXT REL

CODE 1-
 DECW PSP )
 JMP NEXT REL

CODE 2
 MOVW 2 W$   PSP -(
 JMP NEXT REL

CODE 2+
 ADDW2 2 W$   PSP )
 JMP NEXT REL

CODE 2-
 SUBW2 2 W$   PSP )
 JMP NEXT REL

CODE 2*
 MOVW PSP )   0 REG
 ASHL 1 B$   0 REG   0 REG
 MOVW 0 REG   PSP )
 JMP NEXT REL

CODE 2/
 CVTWL PSP )   0 REG
 ASHL -1 B$   0 REG   0 REG
 MOVW 0 REG   PSP )
 JMP NEXT REL

CODE <
 CLRW 0 REG
 CMPW PSP )+   PSP )
 BLEQ 1 FWD
 MNEGW 1 W$   0 REG
1 L: MOVW 0 REG    PSP )
 JMP NEXT REL

CODE =
 CLRW 0 REG
 CMPW PSP )+   PSP )
 BNEQ 1 FWD
 MNEGW 1 W$   0 REG
1 L: MOVW 0 REG   PSP )
 JMP NEXT REL

CODE >
 CLRW 0 REG
 CMPW PSP )+   PSP )
 BGEQ 1 FWD
 MNEGW 1 W$   0 REG
1 L: MOVW 0 REG   PSP )
 JMP NEXT REL

CODE >R
 MOVW PSP )+   SP -(
 JMP NEXT REL

CODE @
 MOVZWL PSP )   0 REG
 MOVW 0 )   PSP )
 JMP NEXT REL

CODE @SP
 MOVW PSP REG   0 REG
 MOVW 0 REG   PSP -(
 JMP NEXT REL

CODE AND
 MCOMW PSP )+   0 REG
 BICW2 0 REG   PSP )
 JMP NEXT REL

CODE C!
 MOVZWL PSP )+   0 REG
 MOVB PSP )+   0 )
 INCW PSP REG
 JMP NEXT REL

CODE C@
 MOVZWL PSP )   0 REG
 MOVBWZ  0 )   PSP )
 JMP NEXT REL

CODE CMOVE
 MOVZWL PSP )+  2 REG
 BEQL 2 FWD
 MOVZWL PSP )   0 REG
 MOVZWL 2 PSP X(   1 REG
1 L: MOVB 1 )+   0 )+
 SOBGTR 2 REG   1 BACK
2 L: ADDW2 4 W$   PSP REG
JMP NEXT REL

CODE D+
 MOVW 2 PSP X(   PSP -(
 MOVW 8 PSP X(   4 PSP X(
 ADDL2 PSP )+   PSP )
 MOVW PSP )+   2 PSP X(
 JMP NEXT REL

CODE DNEGATE
 MOVW 2 PSP X(   PSP -(
 MNEGL PSP )  PSP )
 MOVW PSP )+   2 PSP X(
 JMP NEXT REL

CODE D<
 MOVW 2 PSP X(   PSP -(
 MOVW 8 PSP X(   4 PSP X(
 CLRW 0 REG
 CMPL PSP )+   PSP )+
 BLEQ 1 FWD
 MNEGW 1 W$   0 REG
1 L: MOVW 0 REG   PSP )
 JMP NEXT REL

CODE DROP
 ADDW2 2 W$   PSP REG
 JMP NEXT REL

CODE DUP
 MOVW PSP )   PSP -(
 JMP NEXT REL

CODE M*				( S1 S3 --- [S1*S2]L [S1*S2]H )
 CVTWL PSP )+   0 REG
 CVTWL PSP )   1 REG
 MULL3 0 REG   1 REG   PSP -(
 MOVW PSP )+   2 PSP X(
 JMP NEXT REL

CODE M/				( SDL SDH DIV --- REM QUOT )
 CVTWL PSP )   0 REG		( DIVISOR IS IN R0 )
 MOVW 4 PSP X(   PSP )
 CLRL 2 REG
 MOVL PSP )+   1 REG
 BGEQ 1 FWD
 DECL 2 REG			( SIGNED QUADWORD DIVIDEND IS IN R1,R2 )
1 L: XORL3 2 REG   0 REG   3 REG	( SIGN IS IN R3 )
 EDIV 0 REG   1 REG   4 REG   5 REG
 TSTL 3 REG
 BGEQ 2 FWD			( BRANCH IF SIGN IS NOT NEGATIVE )
 TSTL 5 REG
 BEQL 3 FWD			( BRANCH IF REMAINDER IS ZERO )
 DECL 4 REG			( SUBTRACT ONE FROM QUOTIENT )
 ADDL2 0 REG   5 REG		( ADD DIVISOR TO REMAINDER )
2 L:  3 L:
 MOVW 5 REG   PSP )		( REMAINDER )
 MOVW 4 REG   PSP -(		( QUOTIENT )
 JMP NEXT REL

CODE NEGATE
 MNEGW PSP )   PSP )
 JMP NEXT REL

CODE NOT
 MCOMW PSP )   PSP )
 JMP NEXT REL

CODE OR
 BISW2 PSP )+   PSP )
 JMP NEXT REL

CODE OVER
 MOVW 2 PSP X(   PSP -(
 JMP NEXT REL

CODE R>
 MOVW SP )+   PSP -(
 JMP NEXT REL

CODE R@
 MOVW SP )   PSP -(
 JMP NEXT REL

CODE RESET
 MOVL rsp0 REL   SP REG
 JMP NEXT REL

CODE ROT
 MOVW 4 PSP X(   0 REG
 MOVW 2 PSP X(   4 PSP X(
 MOVW PSP )   2 PSP X(
 MOVW 0 REG   PSP )
 JMP NEXT REL

CODE ROTATE
 BICW3 FFF0 W$   PSP )   0 REG
 MOVW 2 PSP X(   PSP )
 MOVL PSP )   1 REG
 ADDW2 2 W$   PSP REG
 ROTL 0 REG   1 REG   1 REG
 MOVW 1 REG   PSP )
 JMP NEXT REL

CODE SWAP
 MOVW 2 PSP X(   0 REG
 MOVW PSP )   2 PSP X(
 MOVW 0 REG   PSP )
 JMP NEXT REL

CODE U<
 CLRW 0 REG
 CMPW PSP )+   PSP )
 BLEQU 1 FWD
 MNEGW 1 W$   0 REG
1 L: MOVW 0 REG   PSP )
 JMP NEXT REL

CODE U>
 CLRW 0 REG
 CMPW PSP )+   PSP )
 BGEQU 1 FWD
 MNEGW 1 W$   0 REG
 1 L: MOVW 0 REG   PSP )
 JMP NEXT REL

CODE UM*
 MOVZWL PSP )+   0 REG
 MOVZWL PSP )   1 REG
 MULL2 1 REG   0 REG
 MOVL 0 REG   PSP -(
 MOVW PSP )+   2 PSP X(
 JMP NEXT REL

CODE UM/
 MOVZWL PSP )   2 REG
 MOVW 4 PSP X(   PSP )
 MOVL PSP )+   3 REG
 CLRL 4 REG
 EDIV 2 REG   3 REG   0 REG   1 REG
 MOVW 1 REG   PSP )
 MOVW 0 REG   PSP -(
 JMP NEXT REL

CODE XOR
 XORW2 PSP )+   PSP )
 JMP NEXT REL

!E!O!F