Re-post (part 2 of 2) of SYS:ASM for PDP-11 Unix-FORTH

[lwt1 at aplvax]

   Here is a re-post (part 2 of 2) of the SYS:ASM file for PDP-11 
unix-FORTH.  The network mangled the original.  Remove this header
to the ------ cut here ------ line.  Since the SYS:ASM file has been
broken into two pieces, you will need to concatenate them:
	cat SYS:ASM.1 SYS:ASM.2   >SYS:ASM
 

------------------------ cut here -----------------------------------
CODE (FIND)			( ADDR[NAME] ADDR[VOCAB] --- 0 <OR> NFA ) 
MOV PSP )+   0 REG
 BEQ 3 FWD			( EMPTY VOCABULARY? )
 MOV PSP )   3 REG		( POINTER TO NAME )
 MOV 3 )+   2 REG		( NAME LS )
 MOV 3 )   3 REG		( NAME MS )
1 L: MOV 0 )   1 REG
 BIC 200 $   1 REG		( CLEAR IMMEDIATE BIT )
 CMP 1 REG   2 REG		( COMPARE LS )
 BNE 2 FWD
 CMP 2 0 X( 3 REG		( COMPARE MS )
 BEQ 4 FWD
2 L: MOV 4 0 X(   0 REG		( NEXT LINK )
 BNE 1 BACK			( ZERO LINK? )
3 L: 4 L:
 MOV 0 REG   PSP )
 NEXT

CODE WORD			( DEL --- ADDR )
 MOV PSP )   0 REG		( DELIMITER )
 MOV in *$   1 REG		( >IN )
 ADD inbuf $   1 REG            ( R1 HAS ADDRESS OF NEXT BYTE IN STREAM )
 MOV dp *$   2 REG		( HERE )
 MOV 2 REG   PSP )		( RETURN HERE, ADDRESS OF STRING )
1 L: CMP 0 REG   1 )+ BYTE	( SKIP DELIMITERS )
 BEQ 1 BACK
 DEC 1 REG			( BACK UP ONE )
 MOV 1 REG   3 REG
2 L: CMP 0 REG   3 ) BYTE	( DELIMITER? )
 BEQ 3 FWD
 CMP 012 $   3 ) BYTE		( NEWLINE? )
 BEQ 4 FWD
 INC 3 REG			( SKIP UNTIL END OF WORD )
 BR 2 BACK
3 L: 4 L:
 SUB 1 REG   3 REG		( R3 HAS LENGTH )
 MOV 3 REG 2 )+ BYTE 		( SAVE COUNT )
 BEQ 6 FWD			( SKIP IF EOL, I.E. ZERO LENGTH )
5 L: MOV 1 )+   2 )+ BYTE	( MOVE CHARACTERS TO HERE )
 5 3 SOB
6 L: CMP 012 $   1 ) BYTE	( IF NOT NEWLINE )
 BEQ 7 FWD
 INC 1 REG			( SKIP DELIMITER )
7 L: SUB inbuf $   1 REG        ( >IN IS OFFSET FROM START OF TIB )
 MOV 1 REG   in *$		( UPDATE >IN SCANNER )
 MOV 040 $   2 )+ BYTE		( ADD BLANK TO END OF WORD
 NEXT 
 
(     STACK PRIMITIVES )
 
CODE !				( DATA ADDR --- )
 MOV PSP )+   0 REG
 MOV PSP )+   0 )
 NEXT

CODE !SP			( ADDR --- )   ( SET ADDRESS OF STACK TOP. )
 MOV PSP )   PSP REG
 NEXT

CODE +				( N1 N2 --- N1+N2 )
 ADD PSP )+   PSP )
 NEXT

CODE +!				( DATA ADDR --- )
 MOV PSP )+   0 REG
 ADD PSP )+   0 )
 NEXT

CODE -				( N1 N2 --- N1-N2 )
 SUB PSP )+   PSP )
 NEXT

CODE -1				( --- -1 )
 MOV -1 $   PSP -(
 NEXT

CODE 0				( --- 0 )
 CLR PSP -(
 NEXT

CODE 0<				( N --- T/F )
 CLR 0 REG
 TST PSP )
 BPL 1 FWD
 MOV -1 $   0 REG
1 L: MOV 0 REG   PSP )
 NEXT

CODE 0=				( N --- T/F )
 CLR 0 REG
 TST PSP )
 BNE 1 FWD
 MOV -1 $   0 REG
1 L: MOV 0 REG   PSP )
 NEXT

CODE 1				( --- 1 )
 MOV 1 $   PSP -(
 NEXT

CODE 1+				( N --- N+1 )
 INC PSP )
 NEXT

CODE 1-				( N --- N-1 )
 DEC PSP )
 NEXT

CODE 2				( --- 2 )
 MOV 2 $   PSP -(
 NEXT

CODE 2+				( N --- N+2 )
 ADD 2 $   PSP )
 NEXT

CODE 2-				( N --- N-2 )
 SUB 2 $   PSP )
 NEXT

CODE 2*				( N --- 2*N )
 ASL PSP )
 NEXT

CODE 2/				( N --- N/2 )
 ASR PSP )
 NEXT

CODE <				( N1 N2 --- T/F )
 CLR 0 REG
 CMP PSP )+   PSP )
 BLE 1 FWD
 MOV -1 $   0 REG
1 L: MOV 0 REG   PSP )
 NEXT

CODE =				( N1 N2 --- T/F )
 CLR 0 REG
 CMP PSP )+ PSP )
 BNE 1 FWD
 MOV -1 $   0 REG
1 L: MOV 0 REG   PSP )
 NEXT

CODE >				( N1 N2 --- T/F )
 CLR 0 REG
 CMP PSP )+ PSP )
 BGE 1 FWD
 MOV -1 $   0 REG
1 L: MOV 0 REG   PSP )
 NEXT

CODE >R				( N1 --- )
 MOV PSP )+ SP -(
 NEXT

CODE @				( ADDR --- DATA )
 MOV 0 PSP *X(   PSP )
 NEXT

CODE @SP			( --- ADDR )   ( RETURN STACK POINTER )
 MOV PSP REG   0 REG
 MOV 0 REG   PSP -(
 NEXT

CODE AND			( N1 N2 --- N1 & N2 )
 MOV PSP )+   0 REG
 COM 0 REG
 BIC 0 REG   PSP )
 NEXT

CODE C!				( BYTE ADDR --- )
 MOV PSP )+   0 REG
 MOV PSP )+   1 REG
 MOV 1 REG   0 )   BYTE
 NEXT

CODE C@				( ADDR --- BYTE )
 MOV 0 PSP *X(   0 REG   BYTE
 BIC 177400 $   0 REG
 MOV 0 REG   PSP )
 NEXT

CODE CMOVE			( SRC DEST UCOUNT --- )
 MOV PSP )+   2 REG
 BEQ 2 FWD			( DO NOTHING IF LENGTH ZERO )
 MOV PSP )+   0 REG		( DESTINATION )
 MOV PSP )+   1 REG		( SOURCE )
1 L: MOV 1 )+   0 )+ BYTE	( MOVE BYTE )
 1 2 SOB
 BR 3 FWD
2 L: ADD 4 $ PSP REG		( POP TWO STACK ARGS )
3 L: NEXT

CODE D+				( D1L D1H D2L D2H --- [D1+D2]L [D1+D2]H )
 MOV PSP )+   0 REG
 ADD PSP )+   2 PSP X(
 ADC PSP )
 ADD 0 REG   PSP )
 NEXT

CODE D<				( D1L D1H D2L D2H --- T/F )
 CLR 0 REG
 CMP PSP )+   2 PSP X(
 BLT 2 FWD
 BNE 1 FWD
 CMP PSP )   4 PSP X(
 BLE 3 FWD
1 L: MOV -1 $   0 REG
2 L: 3 L:
 ADD 4 $   PSP REG
 MOV 0 REG   PSP )
 NEXT

CODE DNEGATE			( D1L D1H --- [-D1]L [-D1]H )
 COM PSP )
 COM 2 PSP X(
 ADD 1 $   2 PSP X(
 ADC PSP )
 NEXT

CODE DROP			( N --- )
 ADD 2 $   PSP REG
 NEXT

CODE DUP			( N --- N N )
 MOV PSP )   PSP -(
 NEXT

CODE M* 			( S1 S2 --- [S1*S2]L [S1*S2]H )
 MOV PSP )   0 REG
 MUL 0 REG-ONLY   2 PSP X(
 MOV 1 REG   2 PSP X(		( LOW RESULT )
 MOV 0 REG   PSP )		( HIGH RESULT )
 NEXT

CODE M/ 			( SDL SDH DIVISOR --- SREM SQUOT )
 MOV PSP )+   2 REG		( R2 HAS DIVISOR )
 MOV PSP )   0 REG		( R0 HAS HIGH DIVIDEND )
 MOV 2 PSP X(   1 REG		( R1 HAS LOW DIVIDEND )
 MOV 2 REG   3 REG
 EXOR 0 REG-ONLY   3 REG	( R3 HAS SIGN )
 DIV 0 REG-ONLY   2 REG		( DIVIDE BY R2 )
 TST 3 REG
 BPL 1 FWD			( BRANCH IF SIGN IS NOT NEGATIVE )
 TST 1 REG
 BEQ 2 FWD			( BRANCH IF REMAINDER IS ZERO )
 DEC 0 REG			( SUBTRACT ONE FROM QUOTIENT )
 ADD 2 REG   1 REG		( ADD DIVISOR TO REMAINDER )
1 L: 2 L:
 MOV 1 REG   2 PSP X(		( REMAINDER )
 MOV 0 REG   PSP )		( QUOTIENT )
 NEXT

CODE NEGATE			( N --- -N )
 NEG PSP )
 NEXT

CODE NOT			( N --- ONE'S_COMPLEMENT_N )
 COM PSP )
 NEXT

CODE OR				( N1 N2 --- N1 V N2 )
 BIS PSP )+   PSP )
 NEXT

CODE OVER			( N1 N2 --- N1 N2 N1 )
 MOV 2 PSP X(   PSP -(
 NEXT

CODE R>				( --- N )
 MOV SP )+   PSP -(
 NEXT

CODE R@				( --- N )
 MOV SP )   PSP -(
 NEXT

CODE RESET			( --- )   ( RESET RETURN STACK POINTER )
 MOV rsp0 *$   SP REG
 NEXT

CODE ROT			( N1 N2 N3 --- N2 N3 N1 )
 MOV 4 PSP X(   0 REG
 MOV 2 PSP X(   4 PSP X(
 MOV PSP )   2 PSP X(
 MOV 0 REG   PSP )
 NEXT

CODE ROTATE			( WORD NBITS --- WORD' )
 MOV PSP )+    1 REG		( LOOP COUNTER )
 BIC 177760 $   1 REG		( MASK OFF ALL BUT LOWER FOUR BITS )
 BEQ 3 FWD			( SKIP IF ZERO LENGTH ROTATE )
 MOV PSP )   0 REG
1 L: TST 0 REG			( TEST SIGN BIT; CLEAR CARRY )
 BPL 2 FWD
 SEC				( SET CARRY )
2 L: ROL 0 REG			( ROTATE )
 1 1 SOB
 MOV 0 REG   PSP )
3 L: NEXT

CODE SWAP 			( N1 N2 --- N2 N1 )
 MOV 2 PSP X(   0 REG
 MOV PSP )   2 PSP X(
 MOV 0 REG   PSP )
 NEXT

CODE UM*			( N1 N2 --- UL UH )
 CLR 0 REG
 MOV 20 $   1 REG		( R1 := 16 )
 MOV PSP )   2 REG
 MOV 2 PSP X(   3 REG		( MULTIPLIER )
 ROR 3 REG			( GET LS BIT )
1 L: BCC 2 FWD
 ADD 2 REG   0 REG		( ACCUMULATE )
2 L: ROR 0 REG			( SHIFT CARRY INTO R0 )
 ROR 3 REG			( SHIFT INTO R3; GET CARRY BIT )
 1 1 SOB
 MOV 3 REG   2 PSP X(		( SAVE LS WORD )
 MOV 0 REG   PSP )		( SAVE MS WORD )
 NEXT

CODE UM/			( DL DH DIVISOR --- REM QUOT )
 MOV 20 $   0 REG		( 16 BITS )
 MOV PSP )+   1 REG		( DIVISOR )
 MOV PSP )   2 REG		( MS WORD )
 MOV 2 PSP X(   3 REG		( LS WORD )
1 L: ASL 3 REG
 ROL 2 REG
 CMP 1 REG   2 REG
 BHI 2 FWD
 SUB 1 REG   2 REG
 INC 3 REG
2 L: 1 0 SOB
 MOV 2 REG   2 PSP X(		( REMAINDER )
 MOV 3 REG   PSP )		( QUOTIENT )
 NEXT
 
CODE U<				( U1 U2 --- T/F )
 CLR 0 REG
 CMP PSP )+   PSP )
 BLOS 1 FWD
 MOV -1 $   0 REG
1 L: MOV 0 REG   PSP )
 NEXT

 CODE U>			( U1 U2 --- T/F )
 CLR 0 REG
 CMP PSP )+   PSP )
 BHIS 1 FWD
 MOV -1 $   0 REG
1 L: MOV 0 REG   PSP )
 NEXT

CODE XOR			( N1 N2 --- N1xorN2 )
 MOV PSP )+   0 REG
 EXOR 0 REG-ONLY   PSP )
 NEXT