lwt1@aplvax (06/13/84)
Here is a re-post (part 1 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 ------------------------------------
( 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: )
( )
( Lloyd W. Taylor )
( JHU/Applied Physics Lab )
( Johns Hopkins Road )
( Laurel, MD 20707 )
( [301] 953-5000 )
( )
( 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. )
( FORTH ASSEMBLY LANGUAGE SOUCE CODE ) OCTAL
( THIS IS SOURCE CODE TO BE RUN THROUGH THE METACOMPILER - METAASSEMBLER. )
( THEREFORE, THERE ARE DIFFERENCES BETWEEN THIS SOURCE CODE AND SOURCE )
( CODE TO BE ASSEMBLED IN THE ORDINARY WAY. IN PARTICULAR, THERE IS NO )
( IMPLICIT OR EXPLICIT SMUDGING. )
JMP 0 *$ ( JUMP TO STARTUP; WILL BE BACKPATCHED )
LABEL vector
MOV 0 $ IAR REG ( MOVE ABORT TO IAR; WILL BE BACKPATCHED )
60 TRAP 2 , vector ,
NEXT
( VARIABLES AND DATA BUFFERS )
LABEL rsp0 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
DECIMAL 120 RAMALLOT ( 120 BYTES OF INPUT BUFFER )
OCTAL
( INNER INTERPRETER AND LOW-LEVEL RUN TIME WORDS )
CODE (:) ( CODE FOR NEXT )
JMP IAR *)+
( THE CODE FOR CALL IS COMPILED IN-LINE FOR COLON DEFINITIONS. )
( )
( JSR IAR,*$NEXT
( )
CODE (;)
MOV SP )+ IAR REG
NEXT
( THIS IS TRICKY CODE. ALL WORDS DEFINED BY VARIABLE, CONSTANT, OR )
( <BUILDS .. DOES> WORDS WILL HAVE SIMILAR CODE FIELDS. THEREFORE, THE )
( CODE FOR [VARIABLE], [CONSTANT], AND [DOES>] IS SHOW BELOW. )
( EXAMPLE: CODE COMPILED FOR VARIABLE WILL BE: )
( JSR IAR,*$[VARIABLE] )
CODE (VARIABLE)
MOV IAR REG PSP -(
MOV SP )+ IAR REG
NEXT
CODE (CONSTANT)
MOV IAR ) PSP -(
MOV SP )+ IAR REG
NEXT
CODE (DOES>)
MOV IAR )+ 0 REG
MOV IAR REG PSP -(
MOV 0 REG IAR REG
NEXT
( BRANCHING PRIMITIVES )
CODE (LITERAL)
MOV IAR )+ PSP -(
NEXT
CODE BRANCH
MOV IAR ) IAR REG
NEXT
CODE ?BRANCH
MOV PSP )+ 0 REG
BNE 1 FWD
MOV IAR ) IAR REG
JMP IAR *)+ ( NEXT )
1 L: ADD 2 $ IAR REG
NEXT
CODE EXECUTE
JMP PSP *)+
( FORTH-83 DO LOOPS )
CODE (DO)
MOV PSP )+ 1 REG
MOV PSP )+ 0 REG
ADD 100000 $ 0 REG ( LIMIT' := LIMIT + 8000 )
MOV 0 REG SP -(
SUB 0 REG 1 REG ( IINIT' := INIT - LIMIT' )
MOV 1 REG SP -(
NEXT
CODE (LOOP)
INC SP )
BVS 1 FWD
MOV IAR ) IAR REG ( LOOP BACK )
JMP IAR *)+ ( NEXT )
1 L: ADD 4 $ SP REG ( POP RETURN STACK )
ADD 2 $ IAR REG ( SKIP LOOP ADDRESS )
NEXT
CODE (+LOOP)
ADD PSP )+ SP )
BVS 1 FWD
MOV IAR ) IAR REG ( LOOP BACK )
JMP IAR *)+ ( NEXT )
1 L: ADD 4 $ SP REG ( POP RETURN STACK )
ADD 2 $ IAR REG ( SKIP LOOP ADDRESS )
NEXT
CODE I
MOV SP ) 0 REG
ADD 2 SP X( 0 REG ( I := I' + LIMIT' )
MOV 0 REG PSP -(
NEXT
CODE J
MOV 4 SP X( 0 REG
ADD 6 SP X( 0 REG ( J := J' + LIMIT' )
MOV 0 REG PSP -(
NEXT
CODE (LEAVE)
ADD 4 $ SP REG ( POP RETURN STACK )
MOV IAR ) IAR REG ( BRANCH PAST LOOP )
NEXT
( BASIC UNIX SYSTEM INTERFACE ROUTINES )
( BUFFER FOR HOLDING INDIRECT SYSTEM CALLS )
LABEL SYSBUF 0 , ( TRAP INSTRUCTION )
0 , ( ARGUMENT 1 )
0 , ( ARGUMENT 2 )
0 , ( ARGUMENT 3 )
( DATA AND CODE FOR SPAWNING OFF SUBPROCESSES )
HEX
LABEL STATUS 0 , ( WORD FOR RECEIVING RETURN STATUS OF CHILD )
LABEL NAME 622F , 6E69 , 732F , 68 , ( "/bin/sh" )
LABEL 0ARG 6873 , 0 , ( "sh" )
LABEL 1ARG 632D , 0 , ( "-c" )
LABEL ARGV 0ARG , 1ARG , 0 , 0 , ( ARGUMENT LIST )
OCTAL
CODE SHELL ( --- ) ( SPAWN OFF INTERACTIVE SUB-SHELL )
CLR ARGV 2+ *$ ( sh WITH NO ARGUMENTS )
0 L: ( SPAWN SUB-PROCESS. SYSTEM BELOW SHARES THIS CODE )
2 TRAP ( FORK SYSTEM CALL )
BR 2 FWD ( BRANCH TO CHILD PROCESS CODE )
60 TRAP 2 , 1 , ( IGNORE INTERRUPTS )
MOV 0 REG 2 REG ( SAVE OLD VECTOR )
7 TRAP ( WAIT SYSTEM CALL )
ROR 2 REG
BCS 1 FWD ( SKIP IF INTERRUPTS WERE IGNORED )
60 TRAP 2 , vector , ( ELSE, CATCH INTERRUPTS )
1 L: NEXT ( DONE )
2 L: ( CHILD ) ( CHILD PROCESS CODE )
MOV 104473 $ SYSBUF *$ ( EXECE TRAP INSTRUCTION )
MOV NAME $ SYSBUF 2+ *$ ( MOVE NAME POINTER )
MOV ARGV $ SYSBUF 4 + *$ ( MOVE ARGUMENT POINTER )
MOV rsp0 *$ SYSBUF 6 + *$ ( MOVE ENVIRONMENT POINTER )
0 TRAP SYSBUF , ( INDIRECT EXECE SYSTEM CALL )
1 TRAP ( RETURN TO PARENT )
CODE SYSTEM ( ADDR[STRING] --- )
MOV 1ARG $ ARGV 2+ *$ ( MOVE POINTER TO "-c" TO ARGUMENT LIST )
MOV PSP )+ ARGV 4 + *$ ( MOVE POINTER TO COMMAND STRING TO LIST )
BR 0 BACK ( BRANCH TO CODE TO SPAWN SUB-SHELL )
( I/O BUFFER AND CONTROL VARIABLES
LABEL BLOCK 1000 RAMALLOT ( 512 BYTE DISK BUFFER )
LABEL SIZE 0 , ( SIZE IN BYTES )
LABEL INDEX 0 , ( CURRENT OFFSET INTO BLOCK )
LABEL FILED 0 , ( FILE DESCRIPTOR OF FILE THAT OWNS BLOCK )
( FILE POSITION TABLE: EACH SLOT HAS A 32 BIT FILE OFFSET. FILE )
( DESCRIPTOR 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 R0 )
( OUTPUT: CHARACTER OF EOF IN R0 )
( SIDE EFFECTS: R0 AND R1 DESTROYED )
LABEL GETC
CMP 0 REG FILED *$ ( IS THIS FILE CURRENTLY BUFFERED? )
BEQ 0 FWD ( IS SO, DO NOT NEED TO TO SEEK )
MOV 0 REG FILED *$ ( SAVE NEW FD IN BUFFER DESCRIPTOR )
MOV SIZE *$ INDEX *$ ( INDICATE THAT BUFFER IS EMPTY )
MOV 104423 $ SYSBUF *$ ( MOVE LSEEK TRAP INSTRUCTION TO SYSBUF )
ASL 0 REG ASL 0 REG ( MULTIPLY BY 4 TO INDEX INTO POSITION TABLE )
MOV FILEPOS 0 X( SYSBUF 2+ *$ ( HIGH OFFSET WORD )
MOV FILEPOS 2+ 0 X( SYSBUF 4 + *$ ( LOW OFFSET WORD )
CLR SYSBUF 6 + *$ ( OFFSET FROM BEGINNING OF FILE )
MOV FILED *$ 0 REG ( FILE DESCRIPTOR IN R0 )
0 TRAP SYSBUF , ( LSEEK SYSTEM CALL )
MOV FILED *$ 0 REG ( RESTORE FD SINCE CALL DESTROYED R0, R1 )
0 L: MOV 2 REG SP -( ( SAVE R2 )
MOV INDEX *$ 2 REG ( R2 IS INDEX )
CMP 2 REG SIZE *$
BLT 1 FWD ( IF THERE IS STILL DATA IN BUFFER, USE IT )
3 TRAP BLOCK , 1000 , ( READ UP TO 512 BYTES )
BCS 2 FWD ( BRANCH IF ERROR )
MOV 0 REG SIZE *$ ( SAVE SIZE OF BLOCK )
BEQ 3 FWD ( BRANCH IF EOF )
CLR 2 REG ( RESET INDEX )
1 L: MOV BLOCK 2 X( 0 REG BYTE
( GET NEXT CHARACTER )
BIC 17400 $ 0 REG ( MASK OFF HIGH BYTE )
INC 2 REG
MOV 2 REG INDEX *$ ( UPDATE INDEX )
MOV FILED *$ 2 REG ( REUSE R2 TO HOLD FILE DESCRIPTOR )
ASL 2 REG ASL 2 REG ( MULTIPLY BY 4 TO INDEX INTO POSITION TABLE )
ADD 1 $ FILEPOS 2+ 2 X( ( ADD ONE TO CURRENT FILE POSITION )
ADC FILEPOS 2 X(
BR 4 FWD
2 L: 3 L:
MOV -1 $ 0 REG ( RETURN EOF ON ERROR )
4 L: MOV SP )+ 2 REG ( RESTORE R2 )
RTS PC REG-ONLY
CODE OPEN ( ADDR[STRING] MODE --- FD )
MOV 104405 $ SYSBUF *$ ( MOVE TRAP 5 INSTRUCTION TO INDIR AREA )
MOV PSP )+ SYSBUF 4 + *$ ( MOVE MODE )
MOV PSP ) SYSBUF 2+ *$ ( MOVE ADDR[STRING] )
0 TRAP SYSBUF , ( OPEN SYSTEM CALL )
BCC 1 FWD
MOV -1 $ PSP ) ( ERROR, NEGATIVE FILE DESCRIPTOR RETURNED )
BR 2 FWD
1 L: MOV 0 REG PSP ) ( RETURN FILE DESCRIPTOR )
ASL 0 REG ASL 0 REG ( MULTIPLY BY 4 IN INDEX INTO POSITION TABLE )
CLR FILEPOS 0 X( ( INITIALIZE FILE POSITION TO ZERO )
CLR FILEPOS 2+ 0 X(
2 L: NEXT
CODE CREAT ( ADDR[STRING] PMODE --- FD )
MOV 104410 $ SYSBUF *$ ( MOVE TRAP 8 INSTRUCTION TO INDIR AREA )
MOV PSP )+ SYSBUF 4 + *$ ( MOVE PMODE )
MOV PSP ) SYSBUF 2+ *$ ( MOVE ADDRESS OF FILE NAME )
0 TRAP SYSBUF , ( CREAT SYSTEM CALL )
BCC 1 FWD
MOV -1 $ PSP ) ( ERROR, NEGATIVE FILE DESCRIPTOR RETURNED )
BR 2 FWD
1 L: MOV 0 REG PSP ) ( RETURN FILE DESCRIPTOR )
ASL 0 REG ASL 0 REG ( MULTIPLY BY 4 TO INDEX INTO POSITION TABLE )
CLR FILEPOS 0 X( ( INITIALIZE FILE POSITION TO ZERO )
CLR FILEPOS 2+ 0 X(
2 L: NEXT
CODE CLOSE ( FD --- )
MOV 104406 $ SYSBUF *$ ( MOVE TRAP 6 INSTRUCTION TO INDIR AREA )
MOV PSP )+ 0 REG ( FILE DESCRIPTOR )
0 TRAP SYSBUF , ( CLOSE SYSTEM CALL )
NEXT
CODE FEXPECT ( FD ADDR COUNT --- ACTCOUNT )
MOV 2 PSP X( 2 REG ( BUFFER ADDRESS )
MOV PSP )+ 3 REG ( COUNT )
BEQ 3 FWD ( DO NOTHING IF COUNT IS ZERO )
1 L: MOV 2 PSP X( 0 REG ( FILE DESCRIPTOR )
JSR PC REG-ONLY GETC *$ ( GET NEXT CHARACTER )
CMP 0 REG -1 $ ( EOF? )
BEQ 4 FWD ( LEAVE LOOP ON EOF )
CMP 0 REG 011 $ BYTE ( TAB ? )
BNE 2 FWD
MOV 040 $ 0 REG BYTE ( CHANGE TABS TO BLANKS )
2 L: MOV 0 REG 2 )+ BYTE ( SAVE CHARACTER )
CMP 0 REG 012 $ BYTE ( NEWLINE? )
BEQ 5 FWD
1 3 SOB ( DECREMENT COUNT AND CONTINUE IF NON-ZERO )
3 L: 4 L: 5 L:
SUB PSP )+ 2 REG ( COMPUTE ACTUAL NUMBER OF CHARACTERS READ )
MOV 2 REG PSP ) ( RETURN ACTUAL NUMBER )
NEXT
CODE READ ( FD ADDR COUNT --- ACTCOUNT )
MOV 2 PSP X( 2 REG ( BUFFER ADDRESS )
MOV PSP )+ 3 REG ( COUNT )
BEQ 2 FWD ( DO NOTHING IF COUNT IS ZERO )
1 L: MOV 2 PSP X( 0 REG ( FILE DESCRIPTOR )
JSR PC REG-ONLY GETC *$ ( GET NEXT CHARACTER )
CMP 0 REG -1 $ ( EOF? )
BEQ 3 FWD ( LEAVE LOOP ON EOF )
MOV 0 REG 2 )+ BYTE ( SAVE CHARACTER )
1 3 SOB ( DECREMENT COUNT AND CONTINUE IF NON-ZERO )
2 L: 3 L:
SUB PSP )+ 2 REG ( COMPUTE ACTUAL NUMBER OF CHARACTERS READ )
MOV 2 REG PSP ) ( RETURN ACTUAL NUMBER )
NEXT
CODE WRITE ( ADDR COUNT FD --- ACTCOUNT )
MOV 104404 $ SYSBUF *$ ( MOVE TRAP INSTRUCTION TO INDIR AREA )
MOV PSP )+ 0 REG ( FILE DESCRIPTOR )
MOV PSP )+ SYSBUF 4 + *$ ( COUNT )
MOV PSP ) SYSBUF 2+ *$ ( ADDRESS )
0 TRAP SYSBUF , ( WRITE SYSTEM CALL )
BCC 1 FWD
MOV -1 $ 0 REG ( ERROR FLAG )
1 L: MOV 0 REG PSP ) ( RETURN ACTUAL COUNT )
NEXT
CODE SEEK ( FD OFFSETL OFFSETH --- )
MOV 4 PSP X( 0 REG ( FILE DESCRIPTOR )
CMP 0 REG FILED *$ ( IF SEEK ON CURRENTLY BUFFERED FILE )
BNE 1 FWD
MOV -1 $ FILED *$ ( FLAG BUFFER AS INVALID )
1 L: ASL 0 REG ASL 0 REG ( MULTIPLY BY 4 TO INDEX INTO POSITION TABLE )
MOV PSP ) FILEPOS 0 X( ( HIGH OFFSET INTO FILE POSITION TABLE )
MOV 2 PSP X( FILEPOS 2+ 0 X( ( LOW OFFSET INTO FILE POSITION TABLE )
MOV 104423 $ SYSBUF *$ ( MOVE SEEK TRAP INSTRUCTION TO SYSBUF )
MOV PSP )+ SYSBUF 2+ *$ ( MOVE HIGH OFFSET )
MOV PSP )+ SYSBUF 4 + *$ ( MOVE LOW OFFSET )
CLR SYSBUF 6 + *$ ( OFFSET FROM BEGINNING OF FILE )
MOV PSP )+ 0 REG ( FILE DESCRIPTOR IN R0 )
0 TRAP SYSBUF , ( SEEK SYSTEM CALL )
NEXT
CODE TERMINATE ( --- )
CLR 0 REG ( RETURN GOOD STATUS )
1 TRAP ( EXIT SYSTEM CALL )
( SHOULD NOT EXECUTE BEYOND TRAP )lwt1@aplvax (06/13/84)
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