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: Re-post (part 2 of 2) of SYS:ASM for PDP-11 Unix-FORTH Message-ID: <658@aplvax.UUCP> Date: Wed, 13-Jun-84 11:49:57 EDT Article-I.D.: aplvax.658 Posted: Wed Jun 13 11:49:57 1984 Date-Received: Thu, 14-Jun-84 01:46:20 EDT Organization: JHU/Applied Physics Lab, Laurel, MD Lines: 368 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] --- 0NFA ) 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