Re-post (part 1 of 2) of SYS:ASM for PDP-11 Unix-FORTH
lwt1 at aplvax
lwt1 at aplvax
Thu Jun 14 01:48:56 AEST 1984
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 )
More information about the Comp.sources.unix
mailing list