Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-04 - 43,50355/pilot.mac
There is 1 other file named pilot.mac in the archive. Click here to see a list.
	SEARCH PILUNV

	.TITLE	PILOT INITIALIZATION

PILOT:	TDZA	F,F		;CLEAR FLAGS
	MOVSI	F,FL.CCL	;CCL ENTRY
START:	RESET			;RESET ALL I/O
	MOVE	P,PDP		;SET UP PDL
	MOVE	T1,.JBFF	;GET FIRST FREE
	CORE	T1,		;SHRINK CORE BACK DOWN
	  JRST	CORERR		;IMPROBABLE
	SETZB	P2,LOOKIT	;TEMP (P2) & 1ST LOC OF TEMP STORAGE
	MOVE	T1,[FILNAM,,FILNAM+1]	;REST OF TEMP STORAGE
	MOVE	T2,.JBREL	;ALL THE WAY UP TO TOP OF CORE
	BLT	T1,(T2)		;BBLLLIIIITTTTT!
	MOVE	P1,[POINT 6,P2]	;TEMP POINTER
	TLNE	F,FL.CCL	;CCL INPUT?
	JRST	CCLIN		;YES
STAR:	OUTSTR	ASTER		;HERE IF TTY INPUT
	INCHWL	I		;GET CHAR
	CAIL	I,40		;SPECIAL CHAR?
	JRST	LOOP1		;NO--PROCESS
	CAIN	I,"Z"-100	;TTY EOF?
	EXIT	1,		;YES
	CLRBFI			;CLEAR BUFFER
	JRST	STAR		;& TRY AGAIN
INITMP:	SETZ	P2,		;CLEAR P2
	MOVE	P1,[POINT 6,P2]	;RESTORE BYTE POINTER

LOOP:	PUSHJ	P,INCH		;GET CHARACTER FROM WHEREVER
	JUMPE	I,XIT		;NULL--END OF THE LINE.
LOOP1:	CAIN	I,40		;SPACE?
	JRST	LOOP		;YES, IGNORE
	CAIN	I,":"
	JRST	LOADEV		;IF COLON-LOAD THE DEVICE
	CAIE	I,"="
	CAIN	I,"_"
	JRST	BACK		;IF _ OR = STORE REL OR LIST FILE NAME
	CAIN	I,","
	JRST	LODRL1		;IF , STORE REL FILE NAME
	CAIN	I,"!"
	JRST	RUNAME		;IF ! RUN THE PROGRAM
	CAIN	I,"."
	JRST	LODFIL		;IF . LOAD THE FILE NAME
	CAIN	I,"["
	JRST	LODPPN		;IF [ STORE EXT & PROCESS PPN
	CAIN	I,"]"
	JRST	LOOP		;IGNORE ]
	CAIGE	I,40
	JRST	DONE		;IF BREAK, WE'RE DONE
	CAIE	I,"("
	CAIN	I,"/"
	JRST	DONE		;IF A SWITCH, WE'RE DONE TOO.
	SUBI	I,40		;CONVERT TO SIXBIT
	TLNE	P1,770000	;> 6 CHAR?
	IDPB	I,P1		;NO STUFF
	JRST	LOOP		;LOOP

LOADEV:	SKIPE	DEVICE		;IF DEVICE ALREADY FULL
	JRST	TWODEV		;HOLLER
	MOVEM	P2,DEVICE	;STORE DEVICE
	JRST	INITMP		;INIT TEMP & LOOP

LODFIL:	SKIPE	FILNAM		;FILE NAME ALREADY THERE?
	JRST	TWOFIL		;YES
	MOVEM	P2,FILNAM	;STORE FILE NAME
	JRST	INITMP		;& LOOP
BACK:	TRNN	F,FR.LST	;IF LISTING,
	JRST	LODRL1+1	;LOAD REL FILE
	SKIPN	T1,FILNAM	;SKIP & LOAD IF FILE NAME THERE
	MOVE	T1,P2		;ELSE LOAD TEMP
	MOVEM	T1,LSTNAM	;LOAD LIST FILE NAME
	SETZM	FILNAM		;CLEAR OLD FILE NAME
	CAME	P2,LSTNAM	;DID WE LOAD TEMP ALREADY?
	MOVEM	P2,LSTEXT	;NO-TEMP CONTAINS LST EXT.
	MOVE	T1,DEVICE	;LOAD THE DEVICE
	MOVEM	T1,LSTDEV	;TRANSFER
	SETZM	DEVICE		;AND CLEAR DEVICE
	JRST	INITMP		;LOOP

LODRL1:	TRO	F,FR.LST	;COMMA INPLIES LIST FILE
	SKIPN	T1,FILNAM	;SKIP & LOAD IF FILE NAME THERE
	MOVE	T1,P2		;ELSE LOAD TEMP
	MOVEM	T1,RELNAM	;LOAD RELFILE NAME
	SETZM	FILNAM		;CLEAR FILE NAME
	CAME	P2,RELNAM	;DID WE LOAD TEMP?
	MOVEM	P2,RELEXT	;NO-LOAD RELFILE EXT.
	JRST	INITMP		;LOOP

LODPPN:	SETZ	T1,
	SKIPE	PPN
	JRST	TWOPPN
	PUSHJ	P,GETOCT
	CAIE	I,","
	JRST	ILLDEL
	HRLZM	T1,PPN
	SETZ	T1,
	PUSHJ	P,GETOCT
	HRRM	T1,PPN
	JRST	LOOP1

DONE:	PUSHJ	P,SWITCH	;GO FIND SWITCHES (IF ANY)
				;THIS ALSO EATS <CR><LF> IF ANY
	TRZN	F,FR.HLP	;NEED HELP?
	JRST	.+3		;NO HELP NEEDED
	MOVE	1,[SIXBIT/PILOT/]	;THATS US
	PUSHJ	P,.HELPR	;SHOULD BE .REQUEST'ED
	SKIPN	T1,DEVICE	;IF DEVICE IS OMITTED...
	HRLZI	T1,'DSK'	;... "DSK" IS ASSUMED
	MOVEM	T1,DEVICE	;STORE THE DEVICE
	SKIPE	FILNAM		;IF THERE IS A FILE NAME
	JRST	TSTEXT		;SEE IF THERE IS AN EXTENSION
	SKIPN	T1,P2		;IS THERE SOMETHING IN TEMP?
	JRST	START		;NO - BAD SYNTAX
	MOVEM	T1,FILNAM	;MOVE WHATEVER
	JRST	DO.IO		;AND START DOING THE I/O

TSTEXT:	SKIPN	FILEXT		;ALREADY FILE EXTENSION?
	HLLZM	P2,FILEXT	;NO--STORE TEMP
DO.IO:	PUSHJ	P,RDX50		;COMPUTE FILENAME
	MOVEM	T3,R50NAM	;& SAVE FOR PILOTC
	MOVEI	T1,14		;BINARY MODE
	SETZ	T4,
	MOVE	T2,DEVICE	;INPUT DEVICE
	HRRZI	T3,IBUF
	OPEN	IN,T1
	  JRST	NODEV
RELOOK:	MOVE	T1,FILNAM
	MOVE	T2,FILEXT
	SETZ	T3,
	MOVE	T4,PPN
	LOOKUP	IN,T1
	  JRST	NOFILE
	TRNN	F,FR.LST	;NEED A LIST FILE?
	JRST	NOLST		;NO
	SETZ	T1,
	SKIPN	T2,LSTDEV
	MOVSI	T2,'DSK'
	HRLZI	T3,LSTBUF
	OPEN	LST,T1
	  JRST	NODEV
	SKIPN	T1,LSTNAM
	MOVE	T1,FILNAM
	SKIPN	T2,LSTEXT
	MOVSI	T2,'LST'
	SETZB	T3,T4
	ENTER	LST,T1		;MAKE THE LISTFILE
	  JRST	ENTERR
NOLST:	TLNN	F,FL.CCL
	JRST	COMND
	OUTSTR	[ASCIZ/PILOT:	/]
	PUSHJ	P,TYPE
	OUTSTR	[ASCIZ/
/]
	SETZ	P2,
	MOVEM	P3,TMPPTR	;SAVE TMPCOR BUFFER POINTER
	JRST	COMND		;GO DO WHAT THE FILE SAYS TO DO

GETOCT:	PUSHJ	P,INCH
	CAIN	I,40
	JRST	GETOCT
	CAIG	I,"7"
	CAIGE	I,"0"
	POPJ	P,
	IMULI	T1,10
	ADDI	T1,-60(I)
	JRST	GETOCT
RUNAME:	PUSHJ	P,INCH
	CAIN	I,15
	PUSHJ	P,INCH
	MOVEI	T1,T2
	HRLI	T1,1
	SKIPN	T2,DEVICE
	MOVSI	T2,'SYS'
	MOVE	T3,P2
	SETZB	T4,T4+1
	SETZB	T4+2,T4+3
	RUN	T1,
	HALT
RDX50:	MOVE	T1,[POINT 6,RELNAM]	;USE RELFILE NAME
	SKIPN	RELNAM			;UNLESS ITS EMPTY,
	MOVE	T1,[POINT 6,FILNAM]	;THEN USE INPUT FILE NAME
	SETZ	T3,
RDX51:	TLNN	T1,770000
	POPJ	P,
	ILDB	T2,T1
	JUMPE	T2,.+4
	SUBI	T2,17		;IF NUMERIC THIS WILL DO
	CAIL	T2,13		;WAS IT?
	SUBI	T2,7		;NO DO FOR ALPHA
	IMULI	T3,50		;SHIFT TOTAL
	ADD	T3,T2		;ADD IN
	JRST	RDX51		;LOOP

	PUSHJ	P,INCH
SWITCH:	JUMPE	I,CPOPJ		;POPJ IF NULL
	CAIE	I,"("		;OPEN PAREN?
	CAIN	I,"/"		;SLASH?
	JRST	SW1		;YES
	CAIE	I,12
	CAIN	I,33		;LF OR ALT.
	POPJ	P,		;YES. DONE
	CAIN	I,")"		;CLOSE PAREN
	JRST	SWITCH-1	;YES-IGNORE
	CAIE	I,CR		;CR?
	JRST	SW1+1		;NO-SEE IF ITS A SWITCH
	PJRST	INCH		;GET LF

SW1:	PUSHJ	P,INCH		;GET SWITCH
	MOVSI	T1,-STABLN	;TABLE LENGTH
	HLRZ	T2,SWITAB(T1)	;GET TABLE ENTRY
	CAME	I,T2		;MATCH?
	AOBJN	T1,.-2		;NO, LOOP
	JUMPGE	T1,BADSWT	;NO MATCH
	HRRZ	T2,SWITAB(T1)	;GET FLAG
	IOR	F,T2		;LIGHT BITS
	JRST	SWITCH-1	;GET NEXT THING
SWITAB:	SW	(N,FR.TTY)	;N = NO TTY ERROR REPORTING
	SW	(M,FR.MAP)	;M = GIVE A LITTLE MAP
	SW	(H,FR.HLP)	;HELP!!
STABLN==.-SWITAB

BADSWT:	OUTSTR	[ASCIZ/
? UNKNOWN SWITCH "/]
	OUTCHR	I
	OUTSTR	[ASCIZ/"
/]
XIT:	EXIT

INCH:	TLNN	F,FL.CCL	;CCL INPUT?
	JRST	.+3		;NO, SKIP
	ILDB	I,P3		;GET TMPCOR CHAR
	JRST	.+2		;JUST IN CASE...
	INCHWL	I		;GET TTY CHAR.
	CAIL	I,140		;IF LOWER CASE,
	SUBI	I,40		;CONVERT TO UPPER CASE
CPOPJ:	POPJ	P,		;RETURN

TYPE:	MOVE	T2,[POINT 6,T1]
	TLNN	T2,770000
	POPJ	P,
	ILDB	T3,T2
	JUMPE	T3,.-3
	ADDI	T3,40
	OUTCHR	T3
	JRST	TYPE+1

NODEV:	MOVE	T1,T2
	OUTSTR	[ASCIZ/CANNOT OPEN DEVICE /]
	PUSHJ	P,TYPE
	OUTSTR	[BYTE (7) 15,12,0,0,0]
	JRST	START

ENTERR:	OUTSTR	[ASCIZ/ENTER ERROR FOR FILE /]
	PUSHJ	P,TYPE
	HLRZ	T1,T2
	JUMPE	T1,.+3
	OUTCHR	["."]
	PUSHJ	P,TYPE
	OUTSTR	[BYTE (7) 15,12,0]
	JRST	START
NOFILE:	SKIPE	FILEXT
	JRST	.+4
	MOVSI	T1,'PIL'
	MOVEM	T1,FILEXT
	JRST	RELOOK
	MOVE	T1,FILNAM
	OUTSTR	[ASCIZ/NO SUCH FILE /]
	PUSHJ	P,TYPE
	MOVE	T1,FILEXT
	JUMPE	T1,.+3
	OUTCHR	["."]
	PUSHJ	P,TYPE
	OUTSTR	[BYTE (7) 15,12,0,0,0]
	JRST	START

TWODEV:	OUTSTR	[ASCIZ/TWO DEVICES
/]
	JRST	CSTART

TWOFIL:	OUTSTR	[ASCIZ/TWO FILE NAMES
/]
	JRST	CSTART

TWOEXT:	OUTSTR	[ASCIZ/TWO FILE EXTENSIONS
/]
	JRST	CSTART

TWOPPN:	OUTSTR	[ASCIZ/TWO PPNS
/]
	JRST	CSTART

ILLDEL:	OUTSTR	[ASCIZ/ILLEGAL DELIMITER IN PPN
/]

CSTART:	TLNN	F,FL.CCL	;CCL INPUT?
	CLRBFI			;SHOULDN'T BE
	JRST	START		;RESTART SCAN

CORERR:	OUTSTR	[ASCIZ/?CANNOT SHRINK CORE
/]
	JRST	CSTART

ASTER:	ASCIZ /
*/

CCLIN:	SKIPE	P3,TMPPTR	;WAS THERE A TMPCOR BUFFER POINTER?
	JRST	INITMP		;YES--LOADED & GONE
	MOVE	T1,[2,,TMPBLK]	;NO, GET TMPCOR FILE
	TMPCOR	T1,
	PUSHJ	P,NOTEMP
	MOVE	P3,[POINT 7,TBUF]
	JRST	INITMP

NOTEMP:	MOVEI	T1,17		;NO TMPCOR--TRY DISK
	MOVSI	T2,'DSK'
	SETZB	T3,T4
	OPEN	TMPC,T1		;OPEN DISK
	  JRST	NODEV
	PJOB	T1,		;GET JOB NUMBER
	SETZ	T3,
	IDIVI	T1,12		;AND CONVERT
	TRO	T2,20		;TO TMPDISK FILE NAME
	LSHC	T2,-6		;BY THE TRIED & TRUE METHOD
	TLNN	T3,77
	JRST	.-4
	MOVE	T1,T3
	HRRI	T1,'PIL'
	MOVSI	T2,'TMP'	;NNNPIL.TMP
	SETZB	T3,T4
	LOOKUP	TMPC,T1		;LOOKUP
	  JRST	PILOT		;NO CCL FILE, ASSUME TTY INPUT
	INPUT	TMPC,TMPBLK+1	;PUT INTO TMPCOR BUFFER
	SETZ	T1,
	RENAME	TMPC,T1		;DELETE TMPDSK FILE
	  JRST	NOREN		;FAILURE
	RELEAS	TMPC,
	POPJ	P,		;BACK


NOREN:	OUTSTR	[ASCIZ/CANNOT DELETE TEMP DISK FILE
/]
	EXIT

PDP:	IOWD 100,PDL

TMPBLK:	SIXBIT	/PIL/
	IOWD 20,TBUF
	0

	PRGEND	PILOT
	SEARCH PILUNV
	.TITLE PILLOW - PILOT LOW SEG

	RELOC 0

TBUF:	BLOCK 20		;DONT CLEAR TMPCOR BUFFER
TMPPTR:	BLOCK 1			;HOLDS TMPCOR BYTE POINTER
LOOKIT:
FILNAM:	BLOCK 1
FILEXT:	BLOCK 1
	BLOCK 1
PPN:	BLOCK 1
RELNAM:	BLOCK 1
RELEXT:	BLOCK 1
LSTNAM:	BLOCK 1
LSTEXT:	BLOCK 1
DEVICE:	BLOCK 1
LSTDEV:	BLOCK 1
R50NAM:	BLOCK 1		;RADIX 50 FILE NAME FOR RELFILE
LASTOP:	BLOCK 1		;LAST OPCODE USED
LINE:	BLOCK 1		;INTERNAL LINE NUMBER
EDLINE:	BLOCK 1		;LINE NUMBER FROM SOS
	BLOCK 1		;FOR ASCIZ
LINCNT:	BLOCK 1		;LINE OF PAGE
PAGE:	BLOCK 1		;PAGE COUNT
SUBPAG:	BLOCK 1		;SUBPAGE COUNT
ERRORS:	BLOCK 1		;NUMBER OF ERRORS
STRTIM:	BLOCK 1		;RUNTIME AT START OF COMPILATION
SVJBFF:	BLOCK 1		;SAVE .JBFF
LOC:	BLOCK 1		;CURRENT LOCATION IN PROGRAM
ENDLOC:	BLOCK 1		;CURRENT FIRST FREE LOC IN PROGRAM
FSTLOC:	BLOCK 1		;FIRST USER SUPPLIED INSTRUCTION
LITLOC:	BLOCK 1		;FIRST LITERAL LOCATION
PROGRM:	BLOCK 1		;ABS ADDRESS OF PROGRAM START
PDL:	BLOCK 100		;PDL STORAGE
IBUF:	BLOCK 3
OBUF:	BLOCK 3			;BUFFER HEADERS
LSTBUF:	BLOCK 3			;LISTING FILE
SYMTAB:	BLOCK SYMAX		;SYMBOL TABLE
PASS1B:	BLOCK 100		;PASS 1 ERRORS FOR LISTING
ENDLOW=.			;TOP OF LOWSEG

	PRGEND
	SEARCH PILUNV
	.TITLE PILCOD - CODE GENERATION


	DEFINE C (X,Y,Z),<XALL
	ASCII /X/
	SALL>

CTAB1:	CNAMES
CTAB1L==.-CTAB1
	DEFINE C (X,Y,Z),<
	XALL
	Y,,Z
	SALL>

CTAB2:	CNAMES
	SUBTTL INITIALIZATION

COMND:	SETZ	T1,		;ZERO MEANS MYSELF
	RUNTIM	T1,		;GET RUNTIME
	MOVEM	T1,STRTIM	;SAVE IT
	SETZM	LOC		;START AT LOC 0
	SETZB	BUFPTR,BUF	;NO INPUT
	SETZM	LINE		;LINE 0
	MOVE	T1,.JBFF	;GET FIRST FREE
	MOVEM	T1,SVJBFF	;SAVE FIRST FREE
	TRNE	F,FR.LST
	PUSHJ	P,HEDDR0	;IF LISTING DO FIRST HEDDER
	SETZB	P3,I		;CLEAR MISC.
	PUSHJ	P,INCHL		;MAKE INPUT BUFFER
	MOVE	T1,.JBFF	;GET NEW FIRST FREE ABOVE BUFFER
	MOVEM	T1,PROGRM	;SO PROGRAM CAN GO ABOVE IT
	PUSHJ	P,INIT		;INITIAL OVERHEAD
	TRNE	F,FR.EOF	;EMPTY FILE?
	JRST	EOF		;NO NEED TO SCAN THEN
	SUBTTL	OPCODE SCANNER


SCANER:	TRO	F,FR.IGS!FR.NLC	;LOWER CASE & IGNORE SPACES
	PUSHJ	P,INCH		;GET 1ST CHAR
	TRNE	F,FR.P2		;IF ON PASS2
	TRNN	F,FR.LST	;AND NOT LISTING
	AOS	LINE		;NEWLINE
SCAN2:	TRNE	F,FR.EOF	;EOF?
	  JRST	EOF		;YES, WRAP IT UP.
	MOVE	T1,[POINT 7,T2]	;MAKE BYTE POINTER
	SETZ	T2,		;CLEAR DESTINATION
	MOVEI	T3,5		;MAX CHARACTERS TO LOAD
	CAIN	I,CR		;LEADING CR?
	JRST	WASTE		;YES--TRY AGAIN
	CAIN	I,LF		;OR LF
	JRST	SCANER		;YOU NEVER KNOW...
	CAIE	I,"*"		;TAG?
	JRST	SCAN3+1		;NO
	MOVE	T2,[ASCIZ/*/]	;TAGS HAVE NO COLON,
	JRST	SCAN4		;SO DUMMY UP ONE

SCAN3:	PUSHJ	P,INCH		;GET CHAR
	CAIN	I,CR		;EOL?
	  BOMB	F.SCAN		;BAD OPCODE IF CR BEFORE :
	CAIN	I,COLON		;COLON?
	JRST	SCAN4		;OPCODE TERMINATOR
	IDPB	I,T1		;STUFF BYTE
	SOJG	T3,SCAN3	;COUNT&JUMP
	  BOMB	F.SCAN		;5 CHAR & NO :

SCAN4:	TRZ	F,FR.NLC	;LOWER CASE ENABLED
	SKIPN	T2		;JUST COLON?
	MOVE	T2,LASTOP	;YES--GET LAST OPCODE
	MOVSI	T3,-CTAB1L	;TABLE LENGTH
	CAME	T2,CTAB1(T3)	;MATCH?
	AOBJN	T3,.-1		;NO, LOOP
	SKIPL	T3		;FOUND IT?
	  BOMB	F.SCAN		;NO
	CAME	T2,[ASCIZ/*/]	;TAGS DON'T COUNT AS OPCODES
	MOVEM	T2,LASTOP	;YES SAVE IT FOR NEXT LINE
	TRNE	F,FR.P2		;PASS 2?
	SKIPA	T1,CTAB2(T3)	;YES, GET PASS2 ADDRESS & SKIP
	HLRZ	T1,CTAB2(T3)	;GET PASS1 ADDRESS
	JRST	(T1)		;DISPATCH
	SUBTTL TAG PROCESSING

TAG:	PUSHJ	P,LTAG		;LOAD TAG
	JUMPE	T2,[BOMB (F.NTAG)];NO TAG LOADED
	PUSHJ	P,SRCTAB	;SEARCH TABLE
	  JRST	TG2		;NO MATCH
	  BOMB	F.2TAG		;MULTIPLY DEFINED TAG

TG2:	MOVEM	T2,SYMTAB(T1)	;LOAD SYMBOLIC TAG
	MOVE	T2,LOC		;GET ACTUAL ADDRESS
	MOVEM	T2,SYMTAB+1(T1)	;SAVE ADDRESS
	TRO	FR.IGS!FR.NLC	;IGNORE SPACES & LC
	PUSHJ	P,INCH		;GET NEXT
	CAIE	I,CR		;EOL?
	CAIN	I,LF		;..
	JRST	SCANER		;YES--START NEW LINE
	JRST	SCAN2		;NO--SCAN REST OF LINE
	SUBTTL TYPE COMMAND


TYPE:	SETZ	LC,		;CLEAR TEMP LOCATION REGISTER
	JRST	TYP1.4		;AND PROCESS

TYPEY:	MOVE	LC,LOC		;SET TEMP LOCATION ADDRESS
	STORE	<JUMPE 1,0>	;TY: STARTS WITH A JUMPE 1,
	JRST	TYP1.4		;& DO REST

TYPEN:	MOVE	LC,LOC		;SET TEMP ADDRESS REGISTER
	STORE	<JUMPN 1,0>	;TN: = JUMPN 1,

TYP1.4:	TRZ	F,FR.IGS!FR.SUP	;STOP IGNORING SPACES
	PUSHJ	P,INCH		;GET VERY FIRST CHAR.
	CAIE	I,"/"		;SLASH?
	JRST	TYP1.5		;NO - SKIP
	TRO	F,FR.SUP	;SUPRESSING CR
	PUSHJ	P,INCH		;YES--IGNORE 1ST SLASH
TYP1.5:	CAIN	I,CR		;EOL?
	JRST	TYPEND		;SEE IF DONE
	CAIN	I,DOLLAR	;POSSABLY A DATA NAME?
	JRST	TYP1.6		;YES
	CAIN	I,AT		;CURSER COMMAND?
	JRST	TYP1.7		;YES
	TRO	F,FR.TLT	;NO, ITS A LITERAL
	TRZE	F,FR.TTG	;& SEEN TAG?
	STORE	<OUTSTR>	;STUFF TYPE OPCODE
	TRZE	F,FR.TAT	;AT?
	STORE	<IONEOU>	;YES
	JRST	TYP1.5-1	;LOOP

TYP1.6:	PUSHJ	P,LTAG		;LOAD TAG
	JUMPE	T2,TYP1.5	;NO TAG IS NO TAG
	TRZE	F,FR.TTG!FR.TLT	;TAG OR LITERAL?
	STORE	<OUTSTR>	;YES, LOAD OPCODE
	TRZE	F,FR.TAT	;AT?
	STORE	<IONEOU>	;YES
	TRO	F,FR.TTG	;WE HAVE A TAG
	JRST	TYP1.5		;LOOP
TYP1.7:	CLEAR	T4,		;CLEAR AC
	PUSHJ	P,INCH		;GET COMMAND
	CAIG	I,"9"		;TEST FOR NUMERIC
	CAIGE	I,"0"		;..
	JRST	.+4		;NOT NUMERIC
	IMULI	T4,^D10		;BUMP
	ADDI	T4,-60(I)	;SAVE NUMBER IN T1
	JRST	TYP1.7+1	;GET REST OF NUMBER
	CAIE	I,DOLLAR	;@$??
	JRST	.+3		;NO
	TRO	F,FR.TLT	;YES-THEN THE @ IS A LITERAL
	JRST	TYP1.6		;AND DO THE TAG
	MOVSI	T2,-ATTABL	;GET LENGTH OF COMMAND TABLE
	HRRZ	P1,ATTAB(T2)
	CAME	I,P1		;IN TABLE?
	AOBJN	T2,.-2		;NO-LOOP
	JUMPGE	T2,TYP1.5	;NOT @, NOT $ ;ERGO A LITERAL
	TRZE	F,FR.TLT!FR.TTG	;OTHERS?
	STORE	<OUTSTR>	;YES
	TRZE	F,FR.TAT	;OR OTHER @?
	STORE	<IONEOU>	;YES
	TRO	F,FR.TAT	;AT LAST!
	HLRZ	T2,ATTAB(T2)	;GET VALUE OF COMMAND
	JUMPE	T2,TYP1.8	;JUMP IF SPECIAL CURSER COMMAND
	SOJ	T4,		;MINUS ONE
	JUMPLE	T4,TYP1.5-1	;NO REPEATS
	SOJG	T4,.+3		;JUMP IF MORE THAN 2
	STORE	<IONEOU>	;STORE OPCODE
	JRST	TYP1.5-1	;DONE
	ADDI	T4,2		;RESET TO CORRECT NUMBER
	MOVE	T1,T4		;SAVE IT
	HLL	T1,[HRRZI 2,]	;1ST INSTRUCTION
	PUSHJ	P,STOREX	;STORE INSTR.
	MOVE	T3,LOC		;SAVE LOCATION
	STORE	<IONEOU>	;SECOND INSTR.
	MOVE	T1,[SOJG 2,]
	HRR	T1,T3		;COMPLETE INSTR.
	PUSHJ	P,STOREX	;3RD INSTR.
	TRZ	F,FR.TAT	;NO OTHERS
	JRST	TYP1.5-1	;GO BACK

TYP1.8:	TRZ	F,FR.TAT	;NO OTHERS
	MOVE	T1,[IONEOU]	;INSTR.
REPEAT 4,<PUSHJ	P,STOREX>	;4 TIMES
	JRST	TYP1.5-1	;GO BACK
TYPEND:	PUSHJ	P,INCH		;EAT LF
	AOS	LINE		;NEWLINE
	TRO	F,FR.IGS!FR.NLC	;IGNORE SPACES & LC
	PUSHJ	P,INCH		;GET NEXT CHAR
	CAIN	I,CR		;BLANK?
	JRST	TYPEND		;YES--TRY AGAIN
	TRZE	F,FR.TTG	;SAW A TAG AT END?
	STORE	<OUTSTR>	;YES
	TRZE	F,FR.TAT	;HOW ABOUR @?
	STORE	<IONEOU>	;YES
	TRNN	F,FR.SUP	;SUPPRESSING?
	TRO	F,FR.TLT	;NO FLAG FOR THE CR
	CAIN	I,COLON		;CONTINUE?
	JRST	TYP1.4		;YES - GO DO NEW LINE
	TRZE	F,FR.TLT	;IF A LIT
	STORE	<OUTSTR>	;MAKE ONE FOR THE LIT
	TRZ	F,FR.TAL	;CLEAR FLAGS
	JUMPE	LC,SCAN2	;T: HAS NO MODIFIER
	ADD	LC,PROGRM	;ADD OFFSET
	MOVE	T1,LOC		;LOCATION TO JUMP TO
	HRRM	T1,(LC)		;STICK IT BACK THERE
	JRST	SCAN2		;START SCANING NEW LINE
TYPYN2:	AOS	LOC		;BUMP OVER SKIP INST.
TYPE2:	MOVE	T1,[POINT 7,(T2)]
	MOVE	T2,ENDLOC	;START OF LITERAL
	ADD	T2,PROGRM
	SETZ	T3,		;ZERO COUNT
	TRZ	F,FR.IGS	;THIS IS A LITERAL
L0:	PUSHJ	P,INCH		;GET 1ST CHAR.
	CAIE	I,"/"		;SUPPRESS <CRLF>?
	JRST	L1+1		;NO
	TRO	F,FR.SUP	;YES, SUPPRESS
L1:	PUSHJ	P,INCH		;GET THE CHARACTER
	AOJ	T3,		;CHARACTER COUNT
REPEAT 0,<
	CAIE	I,COLON		;COLON?
	JRST	L1.5		;NO, SKIP
	PUSHJ	P,INCH		;YES, GET CHAR. AFTER :
	CAIN	I,CR		;IS IT :<CR>?
	JRST	TLINE		;YES. IGNORE TRAILING COLON
	PUSH	P,I		;NO, SAVE NEW CHAR.
	MOVEI	I,COLON		;SIMULATE COLON
	IDPB	I,T1		;STUFF COLON
	POP	P,I		;RESTORE CHAR.
	AOJ	T3,		;BUMP CHAR. COUNT
L1.5:>
	CAIN	I,CR		;END OF LINE?
	JRST	TLINE		;YES, TEST FOR END OF LITERAL
	CAIN	I,DOLLAR	;TAG?
	JRST	L4		;MAYBE..
	CAIN	I,AT		;CURSER COMMAND?
	JRST	L3.1		;MAYBE..
L3:	IDPB	I,T1		;STUFF IT
	JRST	L1		;DOIT AGAIN
L3.1:	SETZ	T4,
	PUSHJ	P,INCH		;GET NEXT CHARACTER
	CAIG	I,"9"		;NUMERIC?
	CAIGE	I,"0"		;..
	JRST	.+4		;NO
	IMULI	T4,^D10		;BUMP
	ADDI	T4,-60(I)	;ADD
	JRST	L3.1+1		;LOOP
	MOVSI	P1,-ATTABL	;TABLE LENGTH
	HRRZ	P2,ATTAB(P1)	;GET ENTRY
	CAME	I,P2		;MATCH?
	AOBJN	P1,.-2		;NO-LOOP
	JUMPGE	P1,L3.6		;NO MATCH!!
	HLRZ	P2,ATTAB(P1)	;GET CHARACTER
	SOJ	T3,		;DON'T COUNT @
	JUMPE	T3,L3.2		;NO LIT
	PUSH	P,T4		;SAVE COUNT
	IDIVI	T3,5
	AOJ	T3,		;FINISH OFF LITERAL
	MOVE	T1,ENDLOC	;GET 1ST FREE LOC
	MOVE	T2,LOC		;GET LOC OF TYPE OPCODE
	ADD	T2,PROGRM	;ADD OFFSET
	HRRM	T1,(T2)		;PLUG IN ADDRESS
	ADDM	T3,ENDLOC
	PUSHJ	P,CHKEND
	AOS	LOC
	POP	P,T4		;RESTORE T4
L3.2:	JUMPE	P2,L3.3		;JUMP IF SPECIAL CURSER COMMAND
	MOVE	T3,T4		;SAVE T4
	MOVE	T1,ENDLOC
	ADD	T1,PROGRM	;GET ADDRESS
	MOVEM	P2,(T1)		;STUFF CURSER COMMAND LITERAL
	CAIL	T4,3		;DO WE HAVE A LOOP THERE?
	AOS	LOC		;YES - SKIP OVER THE HRRZ 2,N
	MOVE	T1,LOC
	ADD	T1,PROGRM	;GET INSTR. LOC
	MOVE	T2,ENDLOC	;GET ADDRESS OF LITERAL
	HRRM	T2,(T1)		;COMPLETE INSTR.
	AOJ	T1,
	CAIG	T3,2		;SKIP IF OVER 2
	SOJG	T4,.-3		;LOOP FOR ALL INSTRUCTIONS
	AOS	ENDLOC
	SKIPN	T3		;IF 0 ;
	AOS	LOC		;ADVANCE ONE
	CAIL	T3,3		;IF OVER 2,
	MOVEI	T3,2		;MAKE 2
	ADDM	T3,LOC		;ADVANCE LOC
	JRST	TYPE2		;RESTART
L3.3:	MOVE	T1,ENDLOC	;GET ENDLOC
	MOVE	T2,LOC
	ADD	T2,PROGRM	;AND LOC
	HRRM	T1,(T2)		;COMPLETE INSTR
	MOVEI	T3,13		;VERT POS.
	ADD	T1,PROGRM
	MOVEM	T3,(T1)		;DO LITERAL
	AOS	ENDLOC
	MOVE	T1,ENDLOC
	AOJ	T2,
	HRRM	T1,(T2)		;VERT. POS. ARG.
	AOS	ENDLOC
	MOVE	T1,ENDLOC
	AOJ	T2,
	HRRM	T1,(T2)
	MOVEI	T3,20		;HOR. POS.
	ADD	T1,PROGRM
	MOVEM	T3,(T1)		;IN LIT.
	AOS	ENDLOC
	MOVE	T1,ENDLOC
	AOJ	T2,
	HRRM	T1,(T2)		;HOR. POS. ARG.
	AOS	ENDLOC
	MOVEI	T2,4
	ADDM	T2,LOC		;UPDATE LOC
	JRST	TYPE2		;DONE

L3.6:	MOVEI	P2,AT		;SIMULATE @
	IDPB	P2,T1		;STUFF
	JUMPE	T4,L1+1		;NO NUMERIC ARG.
	PUSH	P,T4+1		;SAVE AC FROM DESTRUCTION
	PUSHJ	P,L3.7		;SIMULATE NUMERIC ARG
	POP	P,T4+1		;RESTORE AC
	JRST	L1+1		;RESUME LITERAL

L3.7:	IDIVI	T4,^D10
	JUMPE	T4,.+4
	PUSH	P,T4+1
	PUSHJ	P,L3.7		;STANDARD NUMERIC OUTPUT
	POP	P,T4+1
	ADDI	T4+1,60
	IDPB	T4+1,T1
	POPJ	P,

L4:	MOVE	T4,T2		;SAVE T2
	PUSHJ	P,LTAG		;GET TAG
	JUMPN	T2,L4.3		;WE HAVE A TAG
	MOVE	T2,T4		;RESTORE T2
	MOVEI	P1,DOLLAR	;SIMULATE $
	IDPB	P1,T1		;STUFF $
	JRST	L3		;CONTINUE LIT WITH BREAK CHAR.
L4.3:	SOJ	T3,		;DONT COUNT $
	JUMPE	T3,L4.4
	IDIVI	T3,5
	AOJ	T3,
	MOVE	T1,ENDLOC	;GET 1ST FREE LOC
	MOVE	T4,LOC		;GET LOC OF TYPE OPCODE
	ADD	T4,PROGRM	;ADD OFFSET
	HRRM	T1,(T4)		;PLUG IN ADDRESS
	ADDM	T3,ENDLOC
	PUSHJ	P,CHKEND
	AOS	LOC
L4.4:	PUSHJ	P,SRCTAB	;SEE IF TAG DEFINED
	  JRST	L5		;NO, REALLY A LITERAL
	AOJ	T1,
	MOVE	T2,SYMTAB(T1)	;GET ADDRESS
	MOVE	W,T1		;SAVE T1
	MOVE	T1,LOC
	ADD	T1,PROGRM
	HRRM	T2,(T1)		;STUFF
	HLRZ	T2,SYMTAB(W)	;GET FLAGS
	CAIE	T2,1		;EXTERNAL?
	JRST	L4.5		;NO-SKIP
	MOVE	T2,LOC		;WHERE LAST REFERENCED
	HRRM	T2,SYMTAB(W)	;RE-LINK GLOBAL SYMBOL REQUEST
	HRRZ	T2,(T1)		;GET ADDRESS STORED
	JUMPN	T2,L4.5		;JUMP IF NOT END OF GLOBAL SYMBOL CHAIN
	MOVE	T2,(T1)		;END OF CHAIN
	TLO	T2,20		;FLAG AS NON-RELOC.
	MOVEM	T2,(T1)		;REPLACE
L4.5:	AOS	LOC		;NEXT!
	MOVE	T2,ENDLOC
	ADD	T2,PROGRM
	MOVE	T1,[POINT 7,(T2)]
	SETZ	T3,		;CLEAR CHAR. COUNTER
	JRST	L1+1		;ALREADY HAVE I FROM LTAG

L5:	MOVE	T1,LOC		;GET LOC
	ADD	T1,PROGRM	;PLUS OFFSET
	MOVE	T3,ENDLOC	;GET ENDLOC
	HRRM	T3,(T1)		;MAKE ADDRESS
	ADD	T3,PROGRM	;PLUS OFFSET
	MOVE	T1,[POINT 6,T2]	;POINTER FOR TAG
	MOVE	T4,[POINT 7,(T3)]	;POINTER FOR STORAGE
	PUSH	P,I		;SAVE CURRENT CHAR.
	MOVEI	I,"$"		;START WITH $
	IDPB	I,T4		;STUFF
L5.5:	TLNN	T1,770000	;END TAG?
	JRST	L6		;YES
	ILDB	I,T1		;GET BYTE FROM TAG
	JUMPE	I,L6		;NULL = END OF TAG
	ADDI	I,40		;TO ASCII
	IDPB	I,T4		;STUFF
	JRST	L5.5
L6:	POP	P,I		;RESTORE I
	MOVEI	T1,2		;TAG TOOK UP 1 OR 2 WORDS
	ADDM	T1,ENDLOC	;SO SAY 2 AND DONT CARE IF WRONG
	JRST	L4.5		;SET POINTERS AS IF REAL TAG

TLINE:	TRZN	F,FR.SUP	;SUPRESSING CRLF'S?
	JRST	.+4		;NO, STUFF 'EM
	SOJ	T3,		;YES, DECREMENT COUNT
	PUSHJ	P,INCH		;EAT LF
	JRST	TL1		;& SKIP
	IDPB	I,T1		;LOAD CR
	PUSHJ	P,INCH		;& GET LF
	AOJ	T3,		;UP COUNT
	IDPB	I,T1		;STUFF LF
TL1:	HRRZ	T4,T1		;GET REL. ADDR OF LIT
	ADD	T4,T2		;GET FULL ADDRESS
	ADDI	T4,20		;FOR INSURANCE
	CAMG	T4,.JBREL	;OVER K BOUNDARY?
	JRST	.+3		;NO, SKIP
	CORE	T4,		;CORE
	  BOMB	F.NCOR		;NO GOOD
	TRNN	F,FR.LST
	AOS	LINE		;NEW LINE
	TRO	F,FR.IGS!FR.NLC	;TURN ON LEADING SPACE SUPPRESS
	PUSHJ	P,INCH		;GET FIRST CHAR
	CAIE	I,CR		;BLANK?
	JRST	.+3		;NO, SKIP
	PUSHJ	P,INCH		;EAT LF
	JRST	.-4		;GET 1ST OF NEXT
	CAIE	I,COLON		;IF COLON, CONTINUE LITERAL
	JRST	.+3		;ELSE SKIP OVER
	TRZ	F,FR.IGS!FR.NLC	;STOP IGNORING SPACES
	JRST	L0		;GO ON WITH LIT.
	JUMPE	T3,SCAN2	;JUMP IF NO LITERAL
	IDIVI	T3,5		;GET WORDS USED
	AOJ	T3,		;ROUND UP TO EVEN WORD
	MOVE	T1,ENDLOC	;GET 1ST FREE LOC
	MOVE	T2,LOC		;GET LOC OF TYPE OPCODE
	ADD	T2,PROGRM	;ADD OFFSET
	HRRM	T1,(T2)		;PLUG IN ADDRESS
	ADDM	T3,ENDLOC	;MAKE NEW ENDLOC
	PUSHJ	P,CHKEND	;CHECK IF ENDLOC IS TOO BIG
	AOS	LOC		;NEXT INSTR.
	JRST	SCAN2		;ALREADY HAVE FIRST CHAR.
TLIT:	PUSHJ	P,LTAG
	JUMPE	T2,[BOMB	(F.NTAG)]
	PUSHJ	P,SRCTAB	;GET VALUE OF TAG
	  BOMB	F.UNDF		;NO TAG
	AOJ	T1,		;TO ADDRESS
	MOVE	T2,SYMTAB(T1)
	MOVE	T1,LOC
	ADD	T1,PROGRM
	HRRM	T2,(T1)
	JRST	WASTE2		;GO

ATTAB:	"T"
	1,,"B"
	32,,"U"
	12,,"D"
	25,,"L"
	6,,"R"
	14,,"C"
ATTABL==.-ATTAB
	SUBTTL ACCEPT COMMAND

ACCEPT:	MOVE	T1,[ACCPT.]
	PUSHJ	P,INCH		;GET ADDRESS IF ANY
	CAIN	I,DOLLAR	;LITERAL STORAGE?
	TLO	T1,40		;STORAGE = AC1
	CAIN	I,"#"		;OR NUMERIC STORAGE?
	TLO	T1,100		;AC2 = NUMERIC LIT
	TLNN	T1,140
	JRST	ACCPT1		;NO TAGS
	PUSHJ	P,LODACC	;STORE OPCODE & REMEMBER TAG
	CAIE	I,COMMA		;END ON COMMA?
	JRST	ACCP1A		;NO, SEE IF EOL
	MOVE	T1,[JUMP]	;ARG OF ACCEPT UUO
	PUSHJ	P,INCH		;GET NEXT CHAR.
	CAIE	I,DOLLAR	;TAG?
	CAIN	I,"#"		;OR OTHER
	SKIPA			;YES
	  BOMB	F.NTAG		;COMMA BUT NO $
	JRST	.-11		;LOOP

ACCP1A:	CAIE	I,CR		;DID WE END ON <CR>?
	  BOMB	F.IDLM		;ILLEGAL DELIMITER IN STRING...
	JRST	WASTE		;EAT CR-LF

ACCPT1:	PUSHJ	P,STOREX	;STORE INSTR.
	CAIE	I,CR		;TEST FOR GARBAGE AFTER COLON
	  BOMB	F.NTAG		;GARBAGE.
	JRST	WASTE		;WAS EOL.

ACEPT2:	PUSHJ	P,INCH		;GET 1ST CHAR.
	CAIE	I,DOLLAR	;TAG?
	CAIN	I,"#"		;..
	SKIPA			;YES
	JRST	WASTE2		;NO-DONE
	PUSHJ	P,L2TAG1	;LOAD TAG
	CAIE	I,COMMA		;BREAK ON COMMA?
	JRST	WASTE2		;NO-MUST BE <CR>
	AOS	LOC		;NEXT LOC
	PUSHJ	P,L2TAG		;LOAD 'NUTHER
	JRST	.-4		;LOOP

ALINE:	PUSHJ	P,INCH		;GET 1ST CHAR. AFTER COLON
	CAIE	I,DOLLAR	;$$$$?
	  BOMB	F.NTAG		;AL: MUST HAVE TAG
	MOVE	T1,[ACCPT. 3,]	;ACCEPT LINE UUO
	PUSHJ	P,LODACC	;LOAD UUO & SYMBOL TABLE
	JRST	WASTE		;FORGET REST

ALINE2:	PUSHJ	P,L2TAG		;LOAD THE STORAGE LOCATION.
	JRST	WASTE2		;IGNORE REST
	SUBTTL COMPUTE COMMAND

;I FORTHWITH APPOLOGISE FOR THE FOLLOWING CODE;
;IT IS ONLY THAT I KNOW NO BETTER.


COMPUT:	SETZ	LC,		;CLEAR TEMP ADDRESS REGISTER
	JRST	COMP1		;GO COMPUTE

CY:	MOVE	LC,LOC		;INITIALIZE START ADDRESS LOC
	STORE	<JUMPE 1,0>	;CY: STARTS WITH JUMPE 1,
	JRST	COMP1		;PROCEED

CN:	MOVE	LC,LOC		;WE START HERE
	STORE	<JUMPN 1,0>	;WITH A JUMPN 1,

COMP1:	MOVE	T1,[COMP.]	;COMPUTE UUO
	PUSHJ	P,LODACC	;GET DESTINATION
	PUSHJ	P,CMS		;EAT ANY SPACES
	CAIE	I,"("		;INDEXED DESTINATION?
	JRST	CM2.5		;NO
	STORE	<INDEX.>	;YES--STORE INDEX OPCODE
	PUSHJ	P,BREAK		;EAT UNTIL BREAK
	CAIN	I,")"		;BREAK ON MATCHING PAREN?
	PUSHJ	P,INCH		;YES-CHUCK IT
	PUSHJ	P,CMS		;EAT UP TO THE =
CM2.5:	CAIE	I,"="		;SHOULD BREAK ON EQUALS
	  BOMB	F.COMP		;BAD COMPUTE SYNTAX
	MOVE	T1,[JUMP]	;"VALUE" OPCODE
CM3:	PUSHJ	P,BREAK		;EAT UNTIL BREAK
	CAIE	I,CR		;EOL?
	CAIN	I,42		;QUOTE?
	JRST	CM4
	MOVSI	T2,-CMPTBL	;TABLE LENGTH
	HRRZ	T3,CMPTAB(T2)	;GET CHAR
	CAME	I,T3		;MATCH?
	AOBJN	T2,.-2		;NO, LOOP
	JUMPGE	T2,CM3		;JUST FALSE ALARM
	PUSHJ	P,STOREX	;STUFF OLD UUO
	HLRZ	T1,CMPTAB(T2)	;GET UUO ADDR
	MOVE	T1,(T1)		;GET UUO
	JRST	CM3		;& LOOP

CMPTAB:	[CPLUS.],,"+"		;PLUS
	[CMIN.],,"-"		;MINUS
	[CMULT.],,"*"		;MULT.
	[CDIV.],,"/"		;DIVIDE
	[INDEX.],,"("		;INDEX OPERATOR

CMPTBL==.-CMPTAB
CM4:	PUSHJ	P,STOREX	;STUFF LAST OPCODE
	STORE	<JFCL>		;SAY END OF COMPUTE
	JUMPE	LC,.+4		;IF C:, SKIP
	ADD	LC,PROGRM	;ADD OFFSET TO WHERE WE WERE
	MOVE	T1,LOC		;GET WHERE WE ARE NOW
	HRRM	T1,(LC)		;PUT PRESENT ADDRESS BACK AT THE JUMPX 1,
	CAIE	I,42		;SKIP IF QUOTE
	JRST	WASTE		;T-T-T-THATS ALL FOLKS
CM4.5:	PUSHJ	P,INCH
	CAIE	I,42
	CAIN	I,CR		;POSSABLE ENDING CONDITION?
	JRST	.+2		;YES
	JRST	CM4.5		;NO-CHEW SOME MORE
	PUSHJ	P,INCH		;GET NEXT
	CAIN	I,42
	JRST	CM4.5		;QUOTE QUOTE
	CAIE	I,LF		;EOL?
	JRST	WASTE		;NO-FINISHED ON SINGLE QUOTE
	AOS	LINE
	TRO	F,FR.IGS!FR.NLC
	PUSHJ	P,INCH
	CAIN	I,CR
	JRST	[PUSHJ	P,INCH
		JRST	.-4]
	CAIN	I,COLON
	JRST	CM4.5
	JRST	SCAN2
CMX:	CAIE	I,"+"
	CAIN	I,"-"
	POPJ	P,		;IF + OR -
	CAIE	I,"*"
	CAIN	I,"/"
	POPJ	P,		;OR * OR /
	CAIE	I,"("
	CAIN	I,")"
	POPJ	P,		;( OR )
	CAIE	I,"&"		;OR &
	AOS	(P)		;(E) NONE OF THE ABOVE--SKIP RETURN
	POPJ	P,

CMS:	CAIE	I,SPACE		;GOT A SPACE?
	CAIN	I,TAB		;OR A TAB?
	SKIPA			;YES
	POPJ	P,		;NO-RETURN
	PUSHJ	P,INCH		;GET ANOTHER
	JRST	CMS		;LOOP

CYN2:	AOS	LOC		;ACCOUNT FOR JUMPX 1,
COMP2:	PUSHJ	P,L2TAG1	;LOAD DEST ADDRESS
	HLLZ	T2,SYMTAB+1(T1)	;GET FLAGS AND SUCH
	TLNN	T2,4		;NUMERIC?
	JRST	COMP2A		;NO-SKIP
	MOVSI	T4,40		;SET OFF AC 1
	MOVE	T3,LOC
	ADD	T3,PROGRM	;GET ADDRESS OF THE INSTRUCTION
	HLLZ	T2,1(T3)	;GET NEXT INSTR.
	CAMN	T2,[INDEX.]	;INDEXED?
	IORM	T4,1(T3)		;MAKE IT [INDEX. 1,] IF NUMERIC INDEX
COMP2A:	PUSHJ	P,CMS		;CHASE SPACES
	AOS	LOC		;& MOVE LOC POINTER
	CAIE	I,"("		;INDEXED?
	JRST	COMP4		;NO
	PUSHJ	P,L2TAG1	;LOAD INDEX TAG
COMP3:	CAIN	I,")"		;IF BREAK ON ) --
	PUSHJ	P,INCH		;EAT IT
	PUSHJ	P,CMS
	AOS	LOC
COMP4:	PUSHJ	P,INCH		;GET ATOM
	CAIN	I,LF		;EOL?
	JRST	WASTE2		;FINIS
	PUSHJ	P,CMS		;CHASE SPACES
	PUSHJ	P,CMX		;IS IT A FUNCTION?
	  BOMB	F.COMP		;2 FUNCTIONS
	MOVE	T3,ENDLOC	;GET FIRST FREE LIT LOC
	ADD	T3,PROGRM	;ADD OFFSET
	MOVE	T1,[POINT 7,(T3)]	;POINTER TO ENDLOC
	MOVE	T4,[POINT 6,T2]	;POINTER TO TAG
	CLEAR	T2,		;CLEAR STORAGE
	TRZ	F,FR.IGS	;MIGHT BE A STRING
	CAIN	I,42		;QUOTED STRING?
	JRST	CM9		;SPECIAL CASE
CM5.5:	IDPB	I,T1		;STUFF INTO ENDLOC
	SUBI	I,40		;TO SIXBIT
	IDPB	I,T4		;& INTO B
	PUSHJ	P,INCH		;NEXT
	PUSHJ	P,CMX		;BREAK?
	JRST	CM6
	CAIE	I,SPACE
	CAIN	I,CR
	JRST	CM6
	TLNE	T4,770000	;6 CHARS?
	JRST	CM5.5		;NONE OF THE ABOVE, GET ANOTHER

CM6:	PUSH	P,T1		;SAVE A
	PUSHJ	P,SRCTAB
	  JRST	CM7		;UNDEFINED, ITS A LITERAL
	POP	P,W		;WASTE SAVED POINTER
	AOJ	T1,
	MOVE	T2,SYMTAB(T1)	;GET ADDRESS
	MOVE	W,T1		;SAVE REGISTER
	MOVE	T1,LOC
	ADD	T1,PROGRM
	HRRM	T2,(T1)		;STUFF IN CORE
	HLLZ	T2,SYMTAB(W)	;GET FLAGS
	TLNN	T2,1		;EXTERNAL?
	JRST	CM6.5		;NO-SKIP
	MOVE	T2,LOC		;GET WHERE WE ARE
	HRRM	T2,SYMTAB(W)	;FOR GLOBAL CHAIN
	HRRZ	T2,(T1)		;GET ADDRESS
	JUMPN	T2,CM6.6	;JUMP IF NOT END OF CHAIN
	MOVSI	T2,20		;FLAG AS START OF CHAIN
	IORM	T2,(T1)		;PUT BACK
CM6.5:	TLNN	T2,4		;NUMERIC?
	JRST	CM6.6		;NO-SKIP
	HLLZ	T2,1(T1)	;GET NEXT OPCODE
	MOVSI	T4,40		;SET UP FLAG
	CAMN	T2,[INDEX.]	;INDEX?
	IORM	T4,1(T1)	;YES MAKE INDEX. 1,
CM6.6:	MOVE	T1,ENDLOC
	ADD	T1,PROGRM
	SETZM	(T1)		;KILL WHAT HAS BEEN WRITTEN
	SETZM	(T3)		;+ REST IF ANY
	JRST	COMP3		;& GET ANOTHER ATOM
CM7:	MOVE	T1,LOC
	ADD	T1,PROGRM
	MOVE	T2,ENDLOC
	HRRM	T2,(T1)		;STUFF ENDLOC
	POP	P,T1		;RESTORE A
CM7.5:	CAIN	I,CR
	JRST	CM8
	PUSHJ	P,CMX
	JRST	CM8
	IDPB	I,T1
	PUSHJ	P,INCH
	JRST	CM7.5

CM8:	SETZ	T2,
	IDPB	T2,T1
	TLNE	T1,760000
	JRST	.-2
	AOJ	T3,
	HRRZS	T1
	ADD	T3,T1
	SUB	T3,PROGRM
	MOVEM	T3,ENDLOC
	PUSHJ	P,CHKEND
	JRST	COMP3

CM9:	PUSHJ	P,INCH		;GET CHARACTER
	CAIE	I,42		;QUOTE?
	JRST	CM9.1		;NO
	PUSHJ	P,INCH		;GET NEXT CHAR.
	CAIE	I,42		;QUOTE QUOTE?
	JRST	CM9.8		;NO-END OF STRING
CM9.1:	CAIN	I,CR		;EOL?
	JRST	CM9.2		;YES
	IDPB	I,T1		;STUFF
	JRST	CM9		;LOOP
CM9.2:	PUSHJ	P,INCH		;EAT LF
	TRNN	F,FR.LST
	AOS	LINE
	TRO	F,FR.IGS!FR.NLC
	PUSHJ	P,INCH		;GET 1ST CHAR OF NEW LINE
	CAIN	I,CR		;BLANK LINE?
	JRST	CM9.2		;TRY AGAIN
	CAIE	I,COLON		;CONTINUE?
	JRST	CM9.9		;NO-MISSING END QUOTE
	TRZ	F,FR.IGS!FR.NLC
	MOVEI	I,CR
	IDPB	I,T1		;FAKE UP <CR>
	MOVEI	I,LF
	IDPB	I,T1		;AND <LF>
	JRST	CM9		;LOOP

CM9.8:	SETZ	I,		;IF ENDED BY QUOTE ELSE AT OPCODE
CM9.9:	SETZ	T2,		;NULL
	IDPB	T2,T1
	TLNE	T1,760000
	JRST	.-2
	MOVE	T2,LOC
	MOVE	T4,ENDLOC
	ADD	T2,PROGRM
	HRRM	T4,(T2)		;STORE LOC OF LITERAL
	AOJ	T3,		;BUMP OLD ENDLOC
	HRRZS	T1		;GET LENGTH OF LITERAL
	ADD	T3,T1		;GET NEW ENDLOC
	SUB	T3,PROGRM	;RELATIVE ADDRESS
	MOVEM	T3,ENDLOC	;SAVE
	PUSHJ	P,CHKEND
	AOS	LOC		;FOR JFCL
	JUMPE	I,WASTE2	;WASTE REST
	AOS	LOC
	JRST	SCAN2		;WE ALREADY HAVE 1ST CHAR.
	SUBTTL EXITS



EY:	STORE	<SKIPE 1>
	JRST	EX

EN:	STORE	<SKIPN 1>
EX:	STORE	<EXIT.>		;EXIT UUO
	JRST	WASTE		;WASTE REST

EC:	MOVE	T1,[CALL.]
	PUSHJ	P,INCH
	CAIE	I,DOLLAR	;IN TAG?
	JRST	.+3		;NO DO LITERAL
	PUSHJ	P,LODACC	;YES
	JRST	WASTE		
	PUSHJ	P,STOREX
	JRST	WASTE

EL:	STORE	<LOG.>
	JRST	WASTE

EQ:	STORE	<QUIT.>
	JRST	WASTE

EYN2:	AOS	LOC
EXIT2:	JRST	WASTE2

EC2:	PUSHJ	P,INCH		;GET 1ST CHAR
	CAIN	I,DOLLAR	;IN STORAGE?
	JRST	EC2B		;YEP
	MOVE	T1,ENDLOC	;FIRST FREE
	MOVE	T2,LOC
	AOS	ENDLOC		;FOR SURE
	AOS	ENDLOC		;PROBABLY BE 5 OR 6 ANYWAY
	ADD	T2,PROGRM
	HRRM	T1,(T2)		;MOVE ENDLOC TO REAL CORE
	ADD	T1,PROGRM
	MOVE	T2,[POINT 7,(T1)]
	SETZ	T3,
	SKIPA			;ALREADY HAVE 1ST CHAR.
EC2A:	PUSHJ	P,INCH
	CAIE	I,"."		;IN CASE SOMEONE GETS CUTE..
	CAIN	I,CR		;EOL?
	JRST	WASTE2
	CAIGE	T3,6		;JUST 6
	IDPB	I,T2		;STUFF LITERALLY
	AOJA	T3,EC2A		;COUNT & LOOP

EC2B:	PUSHJ	P,L2TAG1	;LOAD ADDRESS
	JRST	WASTE2		;AND EXIT
	SUBTTL GET, PUT, STRING, & UNSTRING

STR:	SKIPA	T1,[STRN.]	;'STRING' OPCODE
UNSTR:	MOVE	T1,[UNSTR.]	;'UNSTRING' OPCODE
	JRST	PUTIT+1

GETIT:	SKIPA	T1,[GET.]	;GET THE OPCODE FOR LODACC
PUTIT:	MOVE	T1,[PUT.]	;'PUT' OPCODE
	PUSHJ	P,GETNUM	;GET CHANNEL # IF ANY
	JUMPE	T2,.+2		;JUMP IF NO CHANNEL
	DPB	T2,[POINT 4,T1,12]	;STORE CHANNEL #
	CAIE	I,DOLLAR	;MUST BE TO STORAGE
	  BOMB	F.NTAG		;YOU LOSE.
	PUSHJ	P,LODACC	;LOAD THE SYMBOL & OPCODE
	CAIE	I,COMMA		;BREAK ON COMMA?
	JRST	GET1A		;NO-SHOULD BE EOL
	MOVE	T1,[JUMP]	;ARG OPCODE
	PUSHJ	P,INCH		;GET NEXT CHARACTER
	JRST	.-7		;LOOP

GET1A:	CAIE	I,CR		;END ON CR?
	  BOMB	F.IDLM		;NO, HOLLER
	JRST	WASTE		;YES.

GY:	STORE	<SKIPE 1>	;CONDITIONAL. START WITH A SKIP
	JRST	GETIT

GN:	STORE	<SKIPN 1>
	JRST	GETIT

PY:	STORE	<SKIPE 1>
	JRST	PUTIT

PN:	STORE	<SKIPN 1>
	JRST	PUTIT

GC:	MOVE	T1,[GETC.]	;GET CONNECT UUO
	JRST	PUTIT+1

GR:	MOVE	T1,[GETR.]	;GR UUO
	JRST	PUTIT+1

GD:	MOVE	T1,[GETD.]
	JRST	PUTIT+1

GT:	MOVE	T1,[GETT.]
	JRST	PUTIT+1

GL:	MOVE	T1,[GETL.]
	JRST	PUTIT+1

GYN2:	AOS	LOC		;BUMP OVER THE SKIPX
GET2:	PUSHJ	P,GETNUM	;EAT CHANNEL #
	PUSHJ	P,L2TAG+1	;LOAD TAG ADDRESS
	CAIE	I,COMMA		;BREAK ON COMMA?
	JRST	WASTE2		;NO. DONE.
	AOS	LOC		;YES, NEXT LOC
	JRST	GET2		;& RETURN
	SUBTTL OPENS

OPENIN:	SKIPA	T1,[IN.]	;OPEN-LOOKUP
OPENOT:	MOVE	T1,[OUT.]	;OPEN-ENTER
	PUSHJ	P,GETNUM	;GET CHANNEL # IN T2
	DPB	T2,[POINT 4,T1,12]	;STORE CHANNEL
	CAIE	I,DOLLAR	;IN TAG?
	JRST	.+3		;NO, LITERAL
	PUSHJ	P,LODACC	;LOAD SYMBOL AND INSTR.
	JRST	WASTE		;& WASTE REST
	PUSHJ	P,STOREX	;JUST LOAD OPCODE-LIT ADDR ON PASS2
	JRST	WASTE		;THERE IS ONLY 1 ARG.

OPEN2:	PUSHJ	P,GETNUM	;EAT CHANNEL #
	CAIN	I,DOLLAR	;TAG?
	JRST	OPEN2A		;YES
	MOVE	T1,ENDLOC	;FIRST FREE
	MOVEI	T2,2		;CAN USE UP 2 WORDS MAX.
	ADDM	T2,ENDLOC	;BUMP ENDLOC BY 2
	MOVE	T2,LOC		;WHERE WE ARE
	ADD	T2,PROGRM	;PLUS ABS. ADDR. OFFSET
	HRRM	T1,(T2)		;PLUG IN ADDRESS FOR THE OPCODE
	ADD	T1,PROGRM	;NOW TO REAL CORE
	MOVE	T2,[POINT 7,(T1)];LOAD IT AS YOU SEE IT
	SKIPA			;ALREADY HAVE 1ST CHAR.
OPN2:	PUSHJ	P,INCH		;GET CHAR.
	CAIN	I,CR		;IF <CR>--
	JRST	WASTE2		;FINIS
	IDPB	I,T2		;STUFF CHAR. INTO LITERAL
	JRST	OPN2		;LOOP

OPEN2A:	PUSHJ	P,L2TAG1	;STORE TAG LOCATION
	JRST	WASTE2		;THATS ALL FOLKS
	SUBTTL TRAP

TRAPIT:	STORE	<TRAP.>		;TRAP UUO
	JRST	WASTE		;REST IS ON PASS 2

TRAPY:	STORE	<SKIPE 1>	;CONDITIONAL TRAP
	JRST	TRAPIT		;& STORE OPCODE

TRAPN:	STORE	<SKIPN 1>	;..
	JRST	TRAPIT		;..

TRPYN2:	AOS	LOC		;BUMP OVER THE SKIPX
TRAP2:	MOVE	T1,ENDLOC	;FIRST FREE LOC
	MOVE	T2,LOC		;LOC OF INSTR
	ADD	T2,PROGRM	;ABS LOC OF INSTR
	HRRM	T1,(T2)		;ADDR. OF TRAP INSTR. IS ENDLOC
	ADD	T1,PROGRM	;NOW TO ABS FOR LIT.
	MOVE	T2,[4,,400040]	;TRAP ADDRESS
	MOVEM	T2,(T1)		;STORE
	MOVEI	T2,2		;^C TRAP
	MOVEM	T2,1(T1)	;INTO ENDLOC+1
	SETZ	T2,		;CLEAR THE REMAINDER
	MOVEM	T2,2(T1)	;OF THE TRAP BLOCK
	MOVEM	T2,3(T1)	;..
	MOVEI	T3,4		;USED 4 LOCATIONS
	ADDM	T3,ENDLOC	;UPDATE ENDLOC
	PUSHJ	P,CHKEND	;SEE IF GOING TO VIOLATE MEMORY
	JRST	WASTE2		;WASTE REST
	SUBTTL MATCH



ME:	SKIPA	T1,[MATX.]	;MATCH EXACT UUO
MATCH:	MOVE	T1,[MATCH.]	;MATCH UUO
	PUSHJ	P,INCH		;GET CHAR
	CAIN	I,DOLLAR	;MATCH AGAINST TAG?
	JRST	NMATCH		;YES, THEN ITS NUMERIC MATCH TIME.
	PUSHJ	P,STOREX	;NO--JUST STORE OPCODE
	JRST	M0+1		;AND GET REST OF LINE.

M3.5:	PUSHJ	P,INCH
	MOVE	T1,[JUMP]	;OPCODE
	CAIE	I,DOLLAR
	JRST	M0+1
	PUSHJ	P,LODACC
	JRST	WASTE		;NUMERIC MATCHS ARE ONE (MATCH) ARG

MA1:	PUSHJ	P,STOREX
	JRST	M0+1

MA2:	STORE	<JUMP>		;ARG
M0:	PUSHJ	P,INCH		;GET CHAR.
	CAIN	I,LF		;EOL?
	JRST	TMLINE		;TEST NEXT LINE FOR CONTINUE
	CAIN	I,COMMA		;DELIMITER?
	JRST	MA2		;DO THINGS
	CAIN	I,CR		;<CR>?
	JRST	MA2		;DOIT ALSO
	JRST	M0		;LOOP FOR BREAK

ML:	MOVE	T3,[MATL.]
	MOVE	T4,[NMATL.]
	JRST	.+3

MG:	MOVE	T3,[MATG.]
	MOVE	T4,[NMATG.]
	MOVE	T1,T3
	PUSHJ	P,INCH
	CAIE	I,DOLLAR
	JRST	MA1
	MOVE	T1,T4
	PUSHJ	P,LODACC
	CAIN	I,COMMA
	JRST	M3.5
	JRST	NM1

TMLINE:	AOS	LINE		;NEWLINE
	TRO	F,FR.IGS!FR.NLC
	PUSHJ	P,INCH		;GET 1ST CHAR
	CAIN	I,CR
	JRST	TMLINE
	CAIE	I,COLON		;CONTINUATION?
	JRST	SCAN2		;NO, PARSE AS NEW LINE
	TRZ	F,FR.IGS!FR.NLC	;STOP IGNORING SPACES
	JRST	M0		;& LOOP
NMATCH:	MOVE	T1,[NMAT.]
	PUSHJ	P,LODACC	;LOAD TAG
	CAIN	I,COMMA		;BREAK ON COMMA?
	JRST	M3.5		;& TREAT AS ANY OTHER MATCH
	MOVE	T3,[MATX.]
NM1:	MOVE	T1,LOC
	ADD	T1,PROGRM
	SOJ	T1,
	MOVEM	T3,(T1)
	AOJ	T1,
	MOVE	T2,[JUMP]
	MOVEM	T2,(T1)
	AOS	LOC
	JRST	WASTE

MATCH2:	TRZ	F,FR.IGS	;ON YOUR TOES...
	PUSHJ	P,INCH		;THIS IS ALL SIGNIF.
	CAIE	I,DOLLAR	;TAG?
	JRST	M00		;NO, SKIP
	PUSHJ	P,L2TAG1	;LOAD TAG ADDRESS
	CAIE	I,COMMA		;BREAK ON COMMA?
	JRST	M4		;OH-OH, FIXUP
	PUSHJ	P,INCH		;ONWARD & UPWARD
	CAIE	I,DOLLAR	;'NOTHER TAG??
	JRST	M00		;NO, WE GOT A LIT.
	AOS	LOC		;BUMP FOR NEXT ADDRESS STUFF
	PUSHJ	P,L2TAG1	;STUFF AWAY!!
	JRST	WASTE2		;ONLY 1 TAG MATCH ALLOWED

M00:	AOS	LOC		;NEXT LOC
	MOVE	T2,ENDLOC
	ADD	T2,PROGRM
	MOVE	T1,[POINT 7,(T2)]	;POINTER TO ENDLOC
	SETZB	T3,T4
M2:	CAIN	I,LF		;EOL?
	JRST	TMLIN1		;TEST NEXT LINE FOR CONT.
	CAIN	I,COMMA
	JRST	M3		;BUNDLE IT UP
	CAIN	I,CR		;OR <CR>?
	JRST	M3		;JUST AS GOOD
	IDPB	I,T1		;STUFF IT
	PUSHJ	P,INCH
	AOJA	T3,M2		;BUMP COUNT & LOOP

M3:	IDIVI	T3,5		;GET WORDS
	AOJ	T3,		;UP FOR ASCIZ
	MOVE	T1,ENDLOC	;GET ENDLOC
	MOVE	T2,LOC
	ADD	T2,PROGRM
	HRRM	T1,(T2)		;MOVE POINTER
	ADDM	T3,ENDLOC	;UPDATE ENDLOC
	PUSHJ	P,CHKEND	;SEE IF OVER K BOUNDARY
	PUSHJ	P,INCH		;I KNOW..
	JRST	M00		;LOOP FOR ALL MATCH CHARS.
M4:	MOVE	T1,LOC
	ADD	T1,PROGRM
	MOVE	T2,(T1)		;GET IT
	HLLZM	T2,(T1)		;RESTORE OPCODE ONLY
	AOJ	T1,		;NEXT
	HRRM	T2,(T1)		;REPLACE ADDRESS
	AOS	LOC
	JRST	WASTE2

TMLIN1:	TRO	F,FR.IGS!FR.NLC	;IGNORE LEADING SPACES & LC
	PUSHJ	P,INCH		;IF EOF WILL FALL THRU TO SCAN2
	CAIE	I,COLON		;CONTINUE?
	JRST	.+4		;NO, SKIP
	TRZ	F,FR.IGS!FR.NLC
	PUSHJ	P,INCH		;GET NEXT CHAR
	JRST	M00+1		;BACK FOR MORE PUNISHMENT
	CAIN	I,CR		;IF BLANK..
	JRST	TMLIN1		;TEST NEXT LINE.
	TRNN	F,FR.LST	;IF WE AREN'T LISTING..
	AOS	LINE		;BUMP LINE
	JRST	SCAN2		;& GO.
	SUBTTL JUMP


JY:	STORE	<SKIPE 1>	;JUMP ONLY IF AC1 NOT 0
	JRST	JMP

JN:	STORE	<SKIPN 1>	;THE OTHER WAY AROUND.
JMP:	MOVE	T4,[JRST 0]	;J: = JRST
	PUSHJ	P,INCH		;GET TAG OR SWITCH
	CAIN	I,DOLLAR	;COMPUTE JUMP?
	JRST	.+3		;YES, GO DOIT
	PUSHJ	P,L1TAG+1	;LOAD THE TAG
	JRST	WASTE		;DONT NEED ANY MORE
	MOVE	T1,[CJUMP.]	;COMPUTED JUMP OPCODE
	PUSHJ	P,LODACC	;LOAD SYMBOL & OPCODE
	CAIE	I,COMMA		;BREAK ON COMMA?
	JRST	WASTE		;NO, WE'RE DONE.
	MOVE	T4,[JUMP]	;YES--PUT IN A FILLER OPCODE
	PUSHJ	P,L1TAG		;LOAD THE NEXT TAG
	JRST	.-4		;LOOP

JYN2:	AOS	LOC		;BUMP OVER SKIPX
JMP2:	PUSHJ	P,L2TAG		;LOAD THE TAG ADDRESS
	CAIE	I,COMMA		;BREAK ON COMMA?
	JRST	WASTE2		;NO--DONE.
	AOS	LOC		;YES--NEXT LOC
	JRST	.-4		;LOOP
	SUBTTL SUBROUTINE CALL

GOSBY:	STORE	<SKIPE 1>	;CONDITIONAL GOSUB
	JRST	GOSUB

GOSBN:	STORE	<SKIPN 1>	;THE OTHER CONDITIONAL

GOSUB:	MOVE	T4,[PUSHJ 17,0]	;U: = PUSHJ 17,
	PUSHJ	P,INCH		;GET 1ST CHAR.
	CAIN	I,DOLLAR	;COMPUTED GOSUB?
	JRST	.+3		;YES--SKIP
	PUSHJ	P,L1TAG+1	;NO, LOAD ADDRESS
	JRST	WASTE		;AND WASTE REST
	MOVE	T1,[CPUSH.]	;GET OPCODE
	PUSHJ	P,LODACC	;LOAD OPCODE & SYMBOL
	CAIE	I,COMMA		;ANOTHER TAG?
	JRST	WASTE		;NO--DONE
	MOVE	T4,[JUMP]	;GET FILLER OPCODE
	PUSHJ	P,L1TAG		;LOAD IT TOO
	JRST	.-4		;LOOP

GOYN2:	AOS	LOC		;BUMP OVER SKIPX
GOSUB2:	PUSHJ	P,L2TAG		;LOAD TAG ADDRESS
	CAIE	I,COMMA		;ANY MORE?
	JRST	WASTE2		;NO
	AOS	LOC		;YES. NEXT LOC
	JRST	GOSUB2		;LOOP
	SUBTTL EXTERNAL SUBROUTINE LINKAGE

LINKY:	STORE	<SKIPE 1>	;CONDITIONAL LINK
	JRST	LINK

LINKN:	STORE	<SKIPN 1>

LINK:	TRO	F,FR.GLB	;SAY I'M A GLOBAL SYMBOL
	MOVE	T1,[PUSHJ 17,0]	;STANDARD CALL
	PUSHJ	P,LODACC	;DOIT
LN2:	CAIE	I,COMMA		;BREAK ON COMMA?
	JRST	LNK1		;NO, SEE IF EOL
	PUSHJ	P,DTAG		;GET SYMBOL
	TRO	FR.IGS		;IGNORE SPACES AGAIN
	PUSHJ	P,INTER		;RENDER IT INTERNAL
	JRST	LN2		;LOOP

LNK1:	CAIE	I,CR		;EOL?
	  BOMB	F.IDLM		;NO, FUNNY BREAK
	JRST	WASTE		;YES, EAT LF

LYN2:	AOS	LOC
LINK2:	JRST	WASTE2		;WASTE IT

ENTRYP:	TRO	F,FR.END	;THIS PROGRAM IS AN EXTERNAL SUBROUTINE
				;THEREFORE IT HAS NO START ADDRESS
				;SO BE IT.

	PUSHJ	P,LTAG		;GET ENTRY POINT
	TRO	F,FR.IGS
	PUSHJ	P,INTER		;MAKE INTERNAL
	MOVE	T2,LOC		;GET "HERE"
	HRRM	T2,SYMTAB+1(T1)	;SAVE IT
ENTP1:	CAIE	I,COMMA		;BREAK ON COMMA?
	JRST	LNK1		;NO, SEE IF EOL
	PUSHJ	P,DTAG		;GET TAG
	TRO	F,FR.IGS	;TURN BACK ON FLAG
	PUSHJ	P,EXTER		;RENDER IT EXTERNAL
	JRST	ENTP1		;LOOP
	SUBTTL	DIMENSION STATEMENT

;	OUTPUT OF THE STATEMENT "D:$TAG(LEN)" IS:
;
;
;	SYMTAB:	SIXBIT /TAG/
;		BYTE (12) LEN,BYTE (6) 0,,ADDRESS
;
;


DIMENS:	PUSHJ	P,DTAG		;LOAD TAG IN T2
	TRO	F,FR.IGS	;TURN BACK ON IGS FLAG
	PUSHJ	P,SRCTAB	;SEARCH SYMBOL TABLE
	  MOVEM	T2,SYMTAB(T1)	;STUFF SYMBOL
	SETZ	T3,		;CLEAR TOTAL
	CAIE	I,"("		;BREAK ON LEFT PAREN?
	  BOMB	F.COMP		;THAT'LL SHAKE 'EM UP
DNL:	PUSHJ	P,INCH		;GET NUMBER
	CAIG	I,"9"		;> 9?
	CAIGE	I,"0"		;>=0?
	JRST	DIX		;BREAK
	IMULI	T3,12		;DECIMAL SHIFT
	ADDI	T3,-60(I)	;ADD NUMBER TO TOTAL
	JRST	DNL		;DIM. NUM. LOOP

DIX:	LSH	T3,^D24		;SHIFT AWAY FROM INT/EXT BITS
	MOVE	T2,SYMTAB+1(T1)	;GET ADDRESS WORD
	IORM	T3,T2		;SNEAK IN THE NUMBER
	MOVEM	T2,SYMTAB+1(T1)	;SO THAT THE FLAGS AREN'T DISTURBED
	CAIN	I,")"		;BREAK ON PAREN?
	PUSHJ	P,INCH		;GET NEXT
	CAIN	I,COMMA		;BREAK ON COMMA?
	JRST	DIMENS		;YES, START OVER
	CAIN	I,CR		;ON EOL?
	JRST	WASTE		;YES, DONE
	  BOMB	F.IDLM		;NOT COMMA OR EOL-BAD SYNTAX

	;HERE TO RENDER A VARIABLE NUMERIC ONLY

NUMX:	PUSHJ	P,DTAG		;GET TAG
	TRO	F,FR.IGS
	PUSHJ	P,NUMRIC	;ENTER IT AS NUMERIC ONLY
	CAIN	I,COMMA		;COMMA?
	JRST	NUMX		;YES, DOIT AGAIN
	CAIE	I,CR		;LEGAL EOL?
	  BOMB	F.IDLM		;NO-HOLLER
	JRST	WASTE		;YES-FINISH LINE
	SUBTTL I-O ROUTINES


INCH:	TLNE	BUFPTR,760000	;ALL CHARS OUT OF WORD?
	JRST	INCH1		;NO
	PUSHJ	P,INCHL
	JRST	INCH1

INCHL:	PUSHJ	P,INCHX		;GET WORD
	TRNN	BUF,1		;LINE NUMBER?
	JRST	INCHL1		;NO
	TLNE	BUF,770000	;FUNNY?
	MOVEM	BUF,EDLINE	;SAVE IT
	JRST	INCHL		;YES

INCHL1:	MOVE	BUFPTR,[POINT 7,BUF]
	POPJ	P,

INCHX:	SOSGE	IBUF+2
	JRST	.+3
	ILDB	BUF,IBUF+1
	POPJ	P,
	IN	IN,
	JRST	INCHX
	TRO	F,FR.EOF	;SAY WE'RE A WALKING DEAD
	SETZ	BUF,		;CLEAR MINI BUFFER
	POPJ	P,		;RETURN

EOF:	CLOSE	IN,		;CLOSE INPUT FILE
	TRZ	F,FR.EOF	;AND CLEAR EOF FLAG
	TRNN	F,FR.P2		;PASS 2 DONE?
	JRST	STRTP2		;NO, START PASS 2
	PUSHJ	P,TTYEND	;TYPE ERRORS DETECTED
	TRNN	F,FR.LST	;LISTING?
	JRST	LODREL		;NO--GO ON
	PUSHJ	P,LSTCOR	;TELL HOW MUCH CORE USED
	CLOSE	LST,		;CLOSE LIST FILE
	JRST	LODREL		;LOAD REL FILE
INCH1:	ILDB	I,BUFPTR
	TRNN	F,FR.EOF	;SKIP IF EOF
	JUMPE	I,INCH		;DON'T LET NULLS GET THROUGH
	CAIE	I,FF		;OR FORM FEEDS
	CAIN	I,VT		;OR VERTICAL TABS
	JRST	INCH		;..
	CAIE	I,LF		;BREAK?
	JRST	.+3		;NO, SKIP
	TRNE	F,FR.P2		;AND PASS 2?
	PUSHJ	P,TTYBIT	;DO THE TTY BIT
	TRNE	F,FR.LST	;LISTING?
	TRNN	F,FR.P2		;AND ON PASS2?
	JRST	NOLST		;NO--DON'T LIST
	CAIE	I,LF		;END OF LINE?
	JRST	.+3		;NO--SKIP
	PUSHJ	P,LINEIT	;YES--DO END OF LINE STUFF
	SKIPA	I,[LF]		;RELOAD LF & SKIP
	PUSHJ	P,LOUCH		;OUTPUT CHARACTER
NOLST:	TRNN	F,FR.NLC	;LOWER CASE ENABLED?
	JRST	.+3		;YES--SKIP
	CAIL	I,140		;LOWER CASE?
	SUBI	I,40		;CONVERT TO UPPER CASE
	CAIE	I,SPACE		;SPACE?
	CAIN	I,TAB		;TAB?
	TRNN	F,FR.IGS	;IGNORE SPACES & TABS?
	POPJ	P,		;NOT SPACE OR TAB-OR THEY ARE ALLOWED
	JRST	INCH		;YES, GET ANOTHER ONE

LOUCH:	SOSGE	LSTBUF+2
	JRST	.+3
	IDPB	I,LSTBUF+1
	POPJ	P,
	OUTPUT	LST,
	JRST	LOUCH
	SUBTTL LISTING ROUTINES


LINEIT:	PUSHJ	P,LOUCH		;DO LF
	MOVSI	P1,-100		;LENGTH OF TABLE
	HLRZ	P2,PASS1B(P1)	;GET 1ST LINE #
	JUMPE	P2,NOP1ER	;JUMP IF NO ERRORS
	CAME	P2,LINE		;RIGHT TIME?
	AOBJN	P1,.-3		;NO, GET NEXT ONE
	JUMPGE	P1,NOP1ER	;JUMP IF THE IMPROBABLE HAPPENS
	HRRZ	P2,PASS1B(P1)	;GET ADDRESS
	CAME	P2,P3		;SAME ERROR TWICE?
	PUSHJ	P,ERRIT		;NO, DO PASS 1 ERROR
NOP1ER:	JUMPE	P3,NOERR	;JUMP IF NOERROR
	MOVE	P2,P3		;STANDARDIZE
	PUSHJ	P,ERRIT		;DO PASS2 ERROR
NOERR:	MOVE	P1,LINCNT	;GET LINE COUNT
	CAIL	P1,PAGSIZ	;MAX LINES?
	PUSHJ	P,HEDDR1	;YES--NEW PAGE BUT NOT NEW PAGE #
	AOS	LINE		;NEW LINE
	TLNN	BUFPTR,760000	;CAN WE LOOK AHEAD?
	PUSHJ	P,INCHL		;NO, FORCE NEW WORD
	TRNE	F,FR.EOF	;EOF??
	  POPJ	P,		;YES--BAIL OUT.
	MOVE	P2,BUFPTR	;SAVE BYTE POINTER
	ILDB	P1,P2		;THIS IS JUST A SNEAKY LOOK
	JUMPE	P1,NOLINE	;HIT A NULL, MAKE SURE EOF
	CAIE	P1,FF		;FORM FEED?
	CAIN	P1,VT		;OR VERTICAL TAB?
	JRST	NEWPAG		;YES, CELEBRATE NEW PAGE
DOLINE:	MOVEI	P1,TABLIN	;OUTPUT A TAB
	PUSHJ	P,LSTSTR	;..
	PUSHJ	P,LINUM		;DO LINE NUMBER
	MOVEI	P1,TABLIN	;'NUTHER TAB
	SETZ	P3,		;NO MORE
	JRST	LSTSTR		;PJRST

NOLINE:	PUSHJ	P,INCHL		;LOAD MINI-BUFFER
	JRST	NOERR+4		;BACK TO TEST

NEWPAG:	SETZM	SUBPAG		;NEW PAGE = ZERO SUBPAGE
	AOS	PAGE		;NEXT PAGE
	PUSHJ	P,HEDDER	;DO THE HEADER
	JRST	DOLINE		;AND START THE NEXT LINE
ERRIT:	AOS	ERRORS		;COUNT THE ERROR
	MOVEI	P1,CRLF
	PUSHJ	P,LSTSTR
	AOS	LINCNT
	MOVEI	P1,[ASCIZ/*******		/]
	PUSHJ	P,LSTSTR
	MOVE	P1,P2		;TRANSFER ERROR
	PUSHJ	P,LSTSTR
	MOVEI	P1,CRLF		;CAP IT
	PUSHJ	P,LSTSTR
	AOS	LINCNT
	AOS	LINCNT
	JRST	LSTSTR

LINUM:	AOS	LINCNT
	SKIPE	EDLINE		;SEE IF SOS LEFT US ANYTHING
	JRST	DMPLIN		;YES, JUST DUMP LINE
	MOVE	P2,LINE
DECOUT:	SKIPA	P1,[12]
OCTOUT:	MOVEI	P1,10
LSTNUM:	IDIV	P2,P1
	JUMPE	P2,.+4
	PUSH	P,P3
	PUSHJ	P,LSTNUM
	POP	P,P3
	MOVEI	I,60(P3)
	JRST	LOUCH

DMPLIN:	MOVEI	P1,EDLINE
	JRST	LSTSTR

TTYBIT:	MOVSI	P1,-100		;LENGTH OF TABLE
	HLRZ	P2,PASS1B(P1)	;GET LINE #
	JUMPE	P2,TNOBIT	;NO COMPLAINTS AT ALL
	CAME	P2,LINE		;RIGHT LINE?
	AOBJN	P1,.-3		;NO,LOOP
	JUMPGE	P1,TNOBIT	;JUMP IF RAN OUT
	HRRZ	P2,PASS1B(P1)	;GET ADDRESS OF ERROR
	CAME	P2,P3		;SAME AS THIS ONE?
	PUSHJ	P,TTYERR	;NO, DO PASS1 ERROR
TNOBIT:	JUMPE	P3,TTYERX	;SKIP IF NO ERROR
	MOVE	P2,P3
	PUSHJ	P,TTYERR	;DO ERROR
	TRNN	F,FR.LST	;IF NOT LISTING,
	SETZB	P2,P3		;NO MORE
TTYERX:	POPJ	P,

TTYERR:	TRNE	F,FR.TTY	;SUPPOSED TO HOLLER?
	POPJ	P,		;NO
	PUSHJ	P,LINER		;YES--DO LINE NUMBER
	OUTCHR	[TAB]		;-A TAB-
	OUTSTR	(P2)		;THE NOISE.
	OUTSTR	CRLF		;<CR><LF>
	POPJ	P,		;& RETURN
TTYEND:	SKIPN	T1,ERRORS	;GET ERRORS
	POPJ	P,		;IF NO ERRORS DO NOTHING
	OUTSTR	[ASCIZ/
? /]				;OUTPUT SEPERATOR
	MOVE	T2,T1		;SAVE # ERRORS
	PUSHJ	P,TTYNUM	;TYPE ERRORS
	OUTSTR	[ASCIZ/ ERROR/]	;TEXT
	CAIE	T1,1		;SINGULAR?
	OUTCHR	["S"]		;NO--PLURAL
	OUTSTR	[ASCIZ/ DETECTED
/]
	POPJ	P,		;RETURN

LSTCOR:	MOVE	T1,LINCNT	;GET LINE COUNT
	CAILE	T1,^D50		;IF OVER 50
	PUSHJ	P,HEDDR1	;GO TO NEXT PAGE WITH SAME PAGE NUMBER
	MOVE	T1,LINCNT	;(IN CASE HEDDER DONE)
	SUBI	T1,5		;SUBTRACT 5 LINES
	MOVEM	T1,LINCNT	;RESTORE
	MOVEI	P1,CRLF		;NEXT LINE
	PUSHJ	P,LSTSTR
	SKIPN	T1,ERRORS	;SKIP IF ERRORS
	JRST	NOERRM		;NO ERRORS
	MOVE	P2,T1		;GET ERRORS
	PUSHJ	P,DECOUT	;OUTPUT
	MOVEI	P1,[ASCIZ/ ERROR/]
	PUSHJ	P,LSTSTR	;OUTPUT ERROR
	MOVEI	I,"S"		;READY FOR PLURAL
	CAIE	T1,1		;ONLY ONE ERROR?
	PUSHJ	P,LOUCH		;NO--OUTPUT "S"
	MOVEI	P1,[ASCIZ/ DETECTED
/]
	PUSHJ	P,LSTSTR	;OUTPUT REST OF LINE
LCORE1:	MOVE	P2,ENDLOC	;GET LAST LOCATION
	PUSHJ	P,DECOUT	;HOW MANY WORDS USED (DECIMAL)
	MOVEI	P1,[ASCIZ / (/]
	PUSHJ	P,LSTSTR
	MOVE	P2,ENDLOC
	PUSHJ	P,OCTOUT	;HOW MANY WORDS USED (OCTAL)
	MOVEI	P1,[ASCIZ/ OCTAL) WORDS USED
/]
	PUSHJ	P,LSTSTR	;OUTPUT
	SETZ	T1,		;ZERO MEANS ME
	RUNTIM	T1,		;GET RUNTIM
	SUB	T1,STRTIM	;MINUS START TIME
	IDIVI	T1,^D1000	;GET SECONDS
	MOVE	P2,T1		;GET SECONDS FOR OUTPUT
	PUSHJ	P,DECOUT	;OUTPUT
	MOVEI	I,"."		;DECIMAL POINT
	PUSHJ	P,LOUCH
REPEAT 3,<
	IDIVI	T2,^D10
	PUSH	P,T3
>
REPEAT 3,<
	POP	P,T3
	MOVEI	I,60(T3)
	PUSHJ	P,LOUCH
>
	MOVEI	P1,[ASCIZ/ CPU SECONDS USED
/]
	PUSHJ	P,LSTSTR	;OUTPUT
	MOVE	P2,.JBFF	;TOP OF CORE
	ADD	P2,ENDLOC	;PLUS PROGRAM
	SUBI	P2,ENDLOW	;MINUS TOP OF LOWSEG
	ADDI	P2,2000		;PLUS 1K
	LSH	P2,-12		;DIVIDE BY 2000
	PUSHJ	P,DECOUT	;OUTPUT CORE USED
	MOVEI	P1,[ASCIZ/K CORE USED
/]
	PUSHJ	P,LSTSTR	;TYPE IT
	TRNN	F,FR.MAP	;MAP WANTED?
	POPJ	P,		;NO
	SETZ	T1,		;INIT XR
	MOVEI	P1,[ASCIZ/
	SYMBOL MAP

/]
	PUSHJ	P,LSTSTR
LSTMAP:	MOVE	T3,LINCNT	;GET LINES PRINTED
	CAILE	T3,^D55		;OVER 55?
	PUSHJ	P,HEDDR1	;NEW PAGE
	MOVE	T2,SYMTAB(T1)	;GET SYMBOL
	JUMPE	T2,LSTLIT	;END
	MOVEI	I,TAB		;TAB
	PUSHJ	P,LOUCH
	PUSHJ	P,SIXOUT	;TYPE SYMBOL
	MOVEI	I,TAB		;- A TAB -
	PUSHJ	P,LOUCH		;..
	AOJ	T1,		;BUMP TO ADDRESS
	HRRZ	P2,SYMTAB(T1)	;GET ADDRESS
	PUSHJ	P,OCTOUT	;TYPE IT
	HLLZ	T2,SYMTAB(T1)	;GET TYPE
	JUMPE	T2,NOTYPE	;NO TYPE
	TLNN	T2,1		;EXTERNAL?
	JRST	.+3		;NO
	MOVEI	P1,[ASCIZ/	EXTERNAL/]
	PUSHJ	P,LSTSTR
	TLNN	T2,2		;INTERNAL?
	JRST	.+3		;NO (??)
	MOVEI	P1,[ASCIZ/	INTERNAL/]
	PUSHJ	P,LSTSTR
	LDB	P2,[POINT 12,T2,11]	;GET DIM. LENGTH
	JUMPE	P2,NOTYPE	;NOT DIM.
	MOVEI	P1,[ASCIZ/	DIMENSION	/]
	PUSHJ	P,LSTSTR	;TYPE
	PUSHJ	P,DECOUT	;AND NUMBER
NOTYPE:	MOVEI	P1,CRLF		;NEWLINE
	PUSHJ	P,LSTSTR
	SOS	LINCNT		;DECREMENT LINECOUNT
	AOJA	T1,LSTMAP	;LOOP

LSTLIT:	MOVEI	P1,[ASCIZ/
LITERALS START AT /]
	PUSHJ	P,LSTSTR
	MOVE	P2,LITLOC
	SUB	P2,PROGRM
	PUSHJ	P,DECOUT
	MOVEI	P1,[ASCIZ/ (/]
	PUSHJ	P,LSTSTR
	MOVE	P2,LITLOC
	SUB	P2,PROGRM	;TO RELATIVE LOC
	PUSHJ	P,OCTOUT
	MOVEI	P1,[ASCIZ/)
/]
	PJRST	LSTSTR
SIXOUT:	MOVE	T3,[POINT 6,T2]
	TLNN	T3,770000	;ALL DONE?
CPOPJ:	POPJ	P,		;YES
	ILDB	I,T3		;GET CHAR
	JUMPE	I,CPOPJ		;IF NULL, FINI.
	ADDI	I,40		;TO ASCII
	PUSHJ	P,LOUCH		;OUTPUT
	JRST	SIXOUT+1	;LOOP

LSTSTR:	HRLI	P1,440700
	PUSH	P,I
	ILDB	I,P1
	JUMPE	I,.+3
	PUSHJ	P,LOUCH
	JRST	.-3
	POP	P,I
	POPJ	P,

NOERRM:	MOVEI	P1,[ASCIZ/NO ERRORS DETECTED
/]
	PUSHJ	P,LSTSTR	;OUTPUT
	JRST	LCORE1		;& DO REST


STRTP2:	TRO	F,FR.P2		;ON PASS 2
	STORE	<JERK.>		;ALWAYS LAST INSTR
	MOVE	T1,LOC		;END OF OPCODES IS
	MOVEM	T1,ENDLOC	;START OF LITERALS
	ADD	T1,PROGRM	;TO ABS ADDRESS
	MOVEM	T1,LITLOC	;FOR RELOC
	PUSHJ	P,LODTAG	;START PASS2 FIXUPS
	MOVE	T1,FSTLOC	;FIRST GOOD LOCATION
	MOVEM	T1,LOC		;AFTER INIT.
	SETZM	LINE		;INITIALIZE LINE COUNT
	SETZM	EDLINE		;AND SOS LINE
	LOOKUP	IN,LOOKIT
	  BOMB	F.DISS		;FILE DISAPPEARED
	PUSHJ	P,INCHL		;LOAD 1ST BUFFER IN CASE LINE #
	TRNE	F,FR.LST	;IF LISTING,
	PUSHJ	P,LINEIT	; DO WHATEVER LINE #
	JRST	SCANER		;RETURN TO SCANER
	SUBTTL SUBROUTINES



;SUBROUTINE TO STORE AN OPCODE
;CALL WITH OPCODE IN T1
;INCREASES CORE IF NEEDED
;RESPECTS ALL AC'S


STOREX:	PUSH	P,T2		;SAVE T2
	MOVE	T2,LOC		;GET CURRENT LOCATION
	ADD	T2,PROGRM	;ADD ABS. CORE OFFSET
	PUSH	P,T2		;AND SAVE CORE LOC.
	ADDI	T2,10		;FOR INSURANCE
	CAMG	T2,.JBREL	;ABOVE K BOUNDARY?
	JRST	NOCORE		;NEED NO CORE
	CORE	T2,		;GET CORE
	  BOMB	F.NCOR
NOCORE:	POP	P,T2		;RESTORE CORE LOC.
	MOVEM	T1,(T2)		;LOAD INTO PROGRAM STORAGE
	AOS 	LOC
	POP	P,T2		;REPLACE T2
	POPJ	P,

;SUBROUTINE TO CHECK IF ENDLOC HAS GONE OVER K BOUNDARY
;RESPECTS ALL AC'S

CHKEND:	PUSH	P,T3		;SAVE IT
	MOVE	T3,PROGRM
	ADD	T3,ENDLOC
	ADDI	T3,20		;+ UNTIL NEXT TEST
	CAMLE	T3,.JBREL
	JRST	[CORE	T3,
		  BOMB	F.NCOR
		JRST	.+1]
	POP	P,T3
	POPJ	P,
;SUBROUTINE TO SEARCH THE SYMBOL TABLE
;CALL WITH SYMBOL IN T2
;SKIP RETURN IF MATCH. T1 = INDEX
;RETURN IF NO MATCH. T1 = 1ST FREE INDEX

SRCTAB:	SETZ	T1,
	SKIPN	SYMTAB(T1)	;ENTRY EMPTY?
	POPJ	P,		;NO MATCH
	CAME	T2,SYMTAB(T1)	;MATCH?
	JRST	.+3		;NO
	AOS	(P)		;YES
	POPJ	P,
	ADDI	T1,2		;NEXT
	CAIG	T1,SYMAX		;OVERFLOW?
	JRST	SRCTAB+1	;NO
	  BOMB	F.SYOV		;YES

;WASTE REST OF LINE

	PUSHJ	P,INCH		;EAT! EAT!
WASTE:	TRNE	F,FR.EOF	;WALKING DEAD?
	JRST	EOF		;YES
	CAIE	I,LF		;VERY EOL?
	JRST	WASTE-1		;NO--GET SOME MORE
	JRST	SCANER		;GO TO SCANER

	;SUBROUTINE TO GET A (CHANNEL) NUMBER IN T2

GETNUM:	SETZ	T2,		;CLEAR TOTALS
	PUSHJ	P,INCH		;GET CHARACTER
	CAIG	I,"9"		;TEST IF
	CAIGE	I,"0"		;NUMERIC
	JRST	.+4		;NO
	IMULI	T2,^D10		;BUMP UP
	ADDI	T2,-60(I)	;ADD
	JRST	GETNUM+1	;LOOP

	CAIN	I,COMMA		;COMMA?
	PUSHJ	P,INCH		;EAT IT
	POPJ	P,		;RETURN
;	SUBROUTINE TO GET A TAG INTO T2
;POINTER MUST BE AFTER THE $ OR * FOR LTAG ; BEFORE FOR DTAG
;RESPECTS ALL OTHER AC'S

DTAG:	PUSHJ	P,INCH		;GET DOLLAR
	CAIE	I,DOLLAR	;IN FACT?
	CAIN	I,"*"		;..
	SKIPA
	  BOMB	F.NTAG		;NO GOOD

LTAG:	PUSH	P,T1
	PUSH	P,T3		;SAVE T1-T4
	PUSH	P,T4
	TRO	F,FR.NLC	;NO LC IN TAGS
	PUSHJ	P,LTAG1
	TRZ	F,FR.NLC
	POP	P,T4
	POP	P,T3		;RESTORE T1-T4
	POP	P,T1
	POPJ	P,		;RETURN

LTAG1:	MOVE	T1,[POINT 6,T2]	;BYTE POINTER
	SETZ	T2,		;CLEAR TAG
	MOVEI	T3,6		;6 CHARS. MAX
	PUSHJ	P,INCH		;GET ONE
	CAIN	I,DOLLAR	;BETTER NOT BE A $
	  BOMB	F....$		;IT WAS
	TRZ	F,FR.IGS	;NOW STOP IGNORING SPACES
	PUSHJ	P,CHKBRK	;SEE IF BREAK, RETURN IF NOT
	SUBI	I,40		;TO SIXBIT
	IDPB	I,T1		;DEPOSIT BYTE
	SOJG	T3,LTAG1+3	;LOOP FOR 6 CHARS.
	JRST	BREAK		;RETURN ON BREAK CHAR.


;THIS IS CALLED WHEN A TAG IS FOUND ON PASS 2

EATAG:	TRZ	F,FR.IGS	;TURN OFF IGNORE
	TRO	F,FR.NLC	;NO LC (WOULD BE 'BREAK' CHARS.)
	PUSHJ	P,BREAK		;EAT UNTIL BREAK
	SKIPA			;FIRST TEST BREAK
	PUSHJ	P,INCH		;EAT IT
	CAIE	I,TAB		;TAB?
	CAIN	I,SPACE		;OR SPACE?
	JRST	.-3		;YES--IGNORE
	CAIN	I,CR		;<CR>?
	PUSHJ	P,INCH		;YES, EAT LF
	CAIN	I,LF		;<LF>?
	JRST	SCANER		;YES, START NEW LINE
	TRO	F,FR.IGS	;IGNORE SPACES,TABS
	JRST	SCAN2		;START IN THE MIDDLE OF LINE

BREAK:	PUSHJ	P,INCH		;GET NEXT CHAR.
	PUSHJ	P,CHKBRK	;BREAK?
	JRST	BREAK		;NO, TRY AGAIN
;CHECK IF "I" IS A BREAK.
;RETURN IF NOT
;2 LEVEL RETURN IF BREAK

CHKBRK:	CAIG	I,"Z"
	CAIGE	I,"A"		;A-Z?
	SKIPA
	POPJ	P,		;A-Z RETURN
	CAIG	I,"9"
	CAIGE	I,"0"		;0-9?
	POP	P,W		;BREAK!! UPCHUCK A LEVEL
	POPJ	P,		;POP&JUMP TO WHEREVER
;JUST LIKE WASTE, BUT BUMPS LOC AT END

	PUSHJ	P,INCH
WASTE2:	TRNE	F,FR.EOF
	JRST	EOF
	CAIE	I,LF
	JRST	WASTE2-1
	AOS	LOC
	JRST	SCANER


;SUBROUTINE TO ASSIGN ADDRESSES TO UNDEFINED SYMBOLS AT END OF PASS 2

LODTAG:	PUSHJ	P,INIT2		;PASS2 OVERHEAD
	SETZ	T1,		;START SEARCH OF SYMBOL TABLE
L2:	MOVEI	T3,TAGSIZ	;SIZE OF TAG
	SKIPN	SYMTAB(T1)	;TEST SYMBOL
	POPJ	P,		;NOBODY HOME
	AOJ	T1,		;INDEX TO THE ADDRESS PART
	HRRZ	T2,SYMTAB(T1)	;GET ADDRESS
	SKIPE	T2		;SKIP IF NO ADDRESS
	AOJA	T1,L2		;SYMBOL WITH ADDRESS-TRY NEXT SYMBOL
	HLLZ	T2,SYMTAB(T1)	;GET FLAGS
	TLNE	T2,1		;GLOBAL SYMBOL REQUEST?
	AOJA	T1,L2		;DON'T EVEN THINK ABOUT IT.
	TLNE	T2,4		;NUMERIC?
	MOVEI	T3,2		;YES--SIZE OF TAG = 2
	LDB	P1,[POINT 12,T2,11]	;SHOULD POINT TO DIM. LEN.
	MOVE	T2,ENDLOC	;GET ENDLOC
	HRRM	T2,SYMTAB(T1)	;ENDLOC IS THE ADDRESS FOR THE TAG
	MOVE	T4,[ASCIZ/0/]
	ADD	T2,PROGRM	;ADD OFFSET FOR CORE LOC.
	MOVEM	T4,(T2)		;INIT AS ASCII ZERO
	JUMPE	P1,.+3		;JUMP IF NO DIMENSION
	IMUL	P1,T3		;DIMENSION * WORDS/TAG
	ADDM	P1,ENDLOC	;BUMP UP ENDLOC
	ADDM	T3,ENDLOC	;ALWAYS AT LEAST ONCE (ALSO FOR ORIGIN 1)
	PUSHJ	P,CHKEND	;SEE IF ENDLOC IS ABOVE K BOUNDARY
	AOJA	T1,L2		;NEXT SYMBOL.
;SUBROUTINE TO STORE INSTRUCTION IN T1
;AND IMPLICITELY DEFINE THE SYMBOL
;(NOT TO BE USED WITH "*" TAGS)
;PERFORM GLOBAL FIXUPS

LODACC:	PUSH	P,T1		;SAVE INSTR.
	PUSHJ	P,LTAG		;LOAD THE TAG
	JUMPE	T2,[BOMB (F.NTAG)]	;NO TAG
	TRO	F,FR.IGS	;IGNORE SPACES AGAIN
	PUSHJ	P,SRCTAB	;SEARCH SYMBOL TABLE
	  MOVEM	T2,SYMTAB(T1)	;PUT IN TAG W/NO ADDRESS
	MOVE	W,T1		;SAVE INDEX
	POP	P,T1		;RESTORE INSTR.
	TRZE	F,FR.GLB	;GLOBAL SYMBOL?
	JRST	LGLB		;YES
	HLRZ	T3,SYMTAB+1(W)	;GET ITEM TYPE
	CAIE	T3,1		;GLOBAL SYMBOL?
	JRST	STOREX		;NO-PJRST OUT
LGLB:	HRRZ	T3,SYMTAB+1(W)	;GET ADDRESS
	HRR	T1,T3		;SET UP GLOBAL LINK
	SKIPN	T3		;END GLOBAL LINK?
	TLO	T1,20		;YES, FLAG FOR NON-RELOC.
	PUSHJ	P,STOREX	;STORE IT
	MOVE	T1,LOC		;GET LOCATION
	SOJ	T1,		;BACK UP ONE TO CURRENT POSITION
	HRLI	T1,1		;FLAG AS GLOBAL
	MOVEM	T1,SYMTAB+1(W)	;RE-LINK SYMBOL TABLE
	POPJ	P,		;RETURN


;SUBROUTINE TO STORE THE 1ST 4 INSTRUCTIONS OF THE PROGRAM
;	MOVEI	1,0		;ADDRESS OF TABLE
;	GETSEG	1,		;GET OTS
;	HALT			;NO OTS
;	JSP	2,400010	;ENTRY POINT OF OTS

INIT:	MOVSI	T3,-TABLNG	;TABLE  LENGTH
	MOVE	T1,FTAB(T3)	;GET INSTR
	PUSHJ	P,STOREX	;STUFF
	AOBJN	T3,.-2		;LOOP
	MOVEM	T3,FSTLOC	;SAVE THE 1ST NON-OVERHEAD LOC
	POPJ	P,

FTAB:	MOVEI	1,
	CALLI	1,40
	JRST	4,0
	JSP	2,400010
TABLNG==.-FTAB
;SUBROUTINE TO LOAD THE GETSEG TABLE IN THE 1ST LITERAL LOC

INIT2:	MOVE	T1,ENDLOC	;1ST FREE
	HRRM	T1,@PROGRM	;FOR 1ST INSTR. (THE MOVEI 1,)
	MOVSI	T2,-LEN		;GET TABLE LENGTH
	ADD	T1,PROGRM	;MAKE ABS ADDRESS
	MOVE	T3,LTAB(T2)	;GET TABLE ENTRY
	MOVEM	T3,(T1)		;STORE IT
	AOJ	T1,		;NEXT CORE LOC
	AOBJN	T2,.-3		;NEXT TABLE LOC & LOOP
	ADDI	T1,3		;ADD 3 NULLS
	SUB	T1,PROGRM	;MINUS OFFSET
	MOVEM	T1,ENDLOC	;UPDATE ENDLOC
	JRST	CHKEND		;CHECK IT

LTAB:	SIXBIT	/SYS/
	SIXBIT	/PILOTS/
	SIXBIT	/SHR/
LEN==.-LTAB

;SUBROUTINE TO RENDER CERTAIN SYMBOLS INTERNAL OR EXTERNAL OR NUMERIC

NUMRIC:	MOVSI	T3,4		;4=NUMERIC
	JRST	INTER+1
EXTER:	SKIPA	T3,[1,,0]	;1=EXTERNAL
INTER:	MOVSI	T3,2		;2=INTERNAL
	PUSHJ	P,SRCTAB	;FIND SYMBOL (OR END OF TABLE)
	  MOVEM	T2,SYMTAB(T1)	;IF NOT THERE, STICK IT
	HLLM	T3,SYMTAB+1(T1)	;FOR LATER
	POPJ	P,		;RETURN
;SUBROUTINE TO LOAD ADDRESS OF SYMBOL
;THAT HAS BEEN DEFINED IN PASS 1 INTO C(LOC)
;POSITION BEFORE $ OR *
;IF ADDRESS THERE FROM PASS 1, CHECK THAT THEY ARE THE SAME
;USES T1 - T3		;AT END T1 POINTS TO SYMTAB ENTRY

L2TAG:	PUSHJ	P,INCH		;GET NEXT CHAR.
	CAIE	I,"*"		;SHOULD BE TAG
	CAIN	I,DOLLAR	;OF SOME SORT
	JRST	.+3		;YES
	CAIE	I,"#"
	  BOMB	F.NTAG		;NO TAG
L2TAG1:	PUSHJ	P,LTAG		;LOAD TAG
	TRO	F,FR.IGS	;IGNORE SPACES
	PUSHJ	P,SRCTAB	;SEARCH SYMBOL TABLE
	  BOMB	F.UNDF		;UNDEFINED SYMBOL
	MOVE	T2,SYMTAB+1(T1)	;GET ADDRESS
	TLNE	T2,1		;CHAINED GLOBAL SYMBOL?
	POPJ	P,		;YES--ITS ALREADY SET UP
	MOVE	T3,LOC		;GET LOC
	ADD	T3,PROGRM	;ADD OFFSET
	HRRZ	T3,(T3)		;GET ADDR.
	JUMPE	T3,L2TAG2	;NO TEST IF NOT DEF.
	CAMN	T3,T2		;LOCATIONS SAME?
	JRST	CPOPJ		;YES, RETURN
	TRNN	F,FR.BOM	;FATAL ERROR ALREADY?
	  BOMB	F.SYNC		;MEMORY OUT OF SYNC
L2TAG2:	MOVE	T3,LOC		;NO. THEN DONT CONFUSE THE ISSUE
	ADD	T3,PROGRM	;RESET T3
	HRRM	T2,(T3)		;STORE ADDRESS
	POPJ	P,		;RETURN


;SUBROUTINE TO LOAD THE OPCODE IN T4
;AND THE SYMBOL FROM THE SYMBOL TABLE
;BUT DOSEN'T MAKE ANY ENTRIES IN THE SYMBOL
;THEREFOR THIS IS FOR "*" (EXPLICITELY DEFINED) TAGS ONLY
;(LODACC IS FOR "$" TYPE TAGS ON PASS 1)

L1TAG:	PUSHJ	P,DTAG		;LOAD TAG IN B
	TRO	F,FR.IGS	;IGNORE SPACES
	PUSHJ	P,SRCTAB	;SEARCH TABLE
	  JRST	.+3		;NO MATCH
	MOVE	T2,SYMTAB+1(T1)	;GET ADDRESS
	SKIPA
	SETZ	T2,		;ZERO OUT ADDRESS IF NOT DEFINED
	HRR	T4,T2		;COMPLETE INSTRUCTION
	MOVE	T1,T4		;FOR STOREX
	JRST	STOREX		;LOAD INST.
;SUBROUTINE TO MAKE LSTFILE HEADERS
;CALL HEDDR0 FOR NEW PAGE BUT NO FF (START OF PROGRAM)
;CALL HEDDR1 ON PAGE OVERFLOW - NEW SUBPAGE
;CALL HEDDER FOR NEW PAGE

HEDDR0:	AOS	PAGE		;PAGE 1
	JRST	HEDDER+2	;AND SKIP FF

HEDDR1:	AOS	SUBPAG		;NEXT SUBPAGE
HEDDER:	MOVEI	I,FF		;NEW PAGE
	PUSHJ	P,LOUCH
	SETZM	LINCNT
	PUSH	P,T1		;MAKE STORAGE
	PUSH	P,T2
	MOVE	T1,[POINT 6,LOOKIT]
H1:	ILDB	I,T1		;GET FILENAME
	JUMPE	I,H2		;JUMP WHEN DONE
	ADDI	I,40		;TO ASCII
	PUSHJ	P,LOUCH		;OUTPUT
	TLNE	T1,770000	;ALL SIX?
	JRST	H1		;NO LOOP
H2:	MOVEI	P1,[ASCIZ/.PIL	/]
	PUSHJ	P,LSTSTR	;MAKE .PIL WHETHER IT IS OR NOT
	MOVEI	P1,[ASCIZ/CERRITOS COLLEGE  /]
	PUSHJ	P,LSTSTR	;A LITTLE PLUG
	MOVEI	P1,[ASCIZ/PILOT VERSION /]
	PUSHJ	P,LSTSTR
	HLRZ	P2,.JBVER	;GET L.H. .JBVER
	LSH	P2,-6		;SHIFT DOWN TO MAJOR VERSION
	PUSHJ	P,OCTOUT	;IN OCTAL
	HLRZ	I,.JBVER	;GET IT AGAIN
	ANDI	I,77		;MASK OFF MINOR VERSION
	JUMPE	I,.+3		;JUMP IF NO MINOR VERSION
	ADDI	I,100		;ADD ASCII OFFSET
	PUSHJ	P,LOUCH		;OUTPUT
	MOVEI	P1,[ASCIZ/ EDIT /]
	PUSHJ	P,LSTSTR
	HRRZ	P2,.JBVER	;GET R.H. .JBVER
	PUSHJ	P,OCTOUT	;IN OCTAL
	MSTIME	T1,		;GET TIME OF DAY
	IDIVI	T1,^D1000	;GET RID OF MS.
	IDIVI	T1,^D60		;AND SECONDS
	IDIVI	T1,^D60		;AND MINUTE
	MOVEI	P1,[ASCIZ/  /]	;2 SPACES
	PUSHJ	P,LSTSTR	;TYPE SEPERATOR
	MOVE	P2,T1		;GET HOUR
	PUSHJ	P,DECOUT	;PRINT HOUR
	MOVEI	I,COLON
	PUSHJ	P,LOUCH		;PRINT COLON
	MOVE	P2,T2		;GET MINUTES
	IDIVI	P2,^D10		;GET TENS OF MINUTES
	MOVEM	P3,T2		;SAVE REST
	PUSHJ	P,DECOUT	;TYPE TENS OF MINUTES
	MOVE	P2,T2
	PUSHJ	P,DECOUT	;TYPE MINUTES
	MOVEI	P1,[ASCIZ/  /]	;2 SPACES
	PUSHJ	P,LSTSTR	;SEPERATOR,
	DATE	T1,		;GET DATE
	IDIVI	T1,^D31		;DAY-1 IN T2
	MOVEI	P2,1(T2)	;SAVE DAY
	IDIVI	T1,^D12		;MONTH-1 IN T2, YEAR-1964 IN T1
	PUSHJ	P,DECOUT	;OUTPUT DAY
	MOVE	P2,MONTAB(T2)	;GET MONTH NAME
	MOVEI	P1,P2		;..
	PUSHJ	P,LSTSTR	;OUTPUT
	ADDI	T1,^D64		;GET YEAR + 64
	MOVE	P2,T1		;SAVE
	PUSHJ	P,DECOUT	;OUTPUT YEAR
	POP	P,T2		;RESTORE T2
	POP	P,T1		;RESTORE T1
	MOVEI	P1,[ASCIZ/   PAGE /]
	PUSHJ	P,LSTSTR	;SAY "PAGE"
	MOVE	P2,PAGE		;GET PAGE
	PUSHJ	P,DECOUT	;OUTPUT
	SKIPN	P2,SUBPAG	;GET SUBPAGE
	JRST	.+4		;NO SUBPAGE
	MOVEI	I,"-"
	PUSHJ	P,LOUCH		;TYPE PAGE-SUBPAGE SEPERATOR
	PUSHJ	P,DECOUT	;TYPE SUBPAGE
	MOVEI	P1,CRLF		;END OF LINE
	PUSHJ	P,LSTSTR	;OUTPUT
	PUSHJ	P,LSTSTR	;AGAIN
	PUSHJ	P,LSTSTR	;AND AGAIN..
	POPJ	P,		;DONE WITH HEADING



MONTAB:	MONMAC <JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC>
LINER:	SKIPN	EDLINE		;SOS LINE NUMBER?
	JRST	NOEDIT		;NO--DO INTERNAL LINE #
	MOVE	T2,EDLINE	;GET LINE #
	SETZ	T3,		;FOR ASCIZ
	OUTSTR	T2		;OUTPUT LINE #
	POPJ	P,		;RETURN

NOEDIT:	MOVE	T2,LINE		;GET INTERNAL LINE NUMBER
TTYNUM:	IDIVI	T2,^D10		;STANDARD ROUTINE
	JUMPE	T2,.+4
	PUSH	P,T3
	PUSHJ	P,TTYNUM
	POP	P,T3
	ADDI	T3,60
	OUTCHR	T3
	POPJ	P,

PUNT:	TRO	F,FR.BOM
	TRNN	F,FR.P2		;PASS 2?
	JRST	DO1BIT		;NO, SAVE IT
	MOVE	P3,ERRTAB(T1)	;YES, SAVE TILL EOL
ENDBIT:	TRNN	F,FR.P2		;ON PASS 2?
	SETZ	P3,		;NO,CLEAN UP UNUSED ERROR
	JRST	WASTE

DO1BIT:	MOVSI	T2,-100
	SKIPE	PASS1B(T2)
	AOBJN	T2,.-1
	JUMPGE	T2,ENDBIT
	MOVE	T3,LINE
	HRLZM	T3,PASS1B(T2)
	MOVE	P3,ERRTAB(T1)
	HRRM	P3,PASS1B(T2)
	JRST	ENDBIT

CRLF:	ASCIZ/
/
TABLIN:	ASCIZ /	/
	DEFINE	FX (X,Y),<
	XLIST
	[ASCIZ/Y/]
	LIST>

ERRTAB:	FATALS
	PRGEND
	SEARCH PILUNV

.TITLE PILREL - RELFILE GENERATOR

LODREL:	CLOSE	IN,		;DONE WITH THE INPUT.
	RELEAS	IN,		;..
	MOVE	T1,SVJBFF	;RESTORE .JBFF
	MOVEM	T1,.JBFF	;TO ORIGINAL STATUS
	MOVEI	T1,1		;ASSUME AN ERROR
	TRNE	F,FR.BOM	;DID WE BOMB?
	ADDM	T1,.JBERR	;YES-BUMP UP .JBERR
	MOVEI	T1,14		;BINARY MODE
	MOVSI	T2,'DSK'	;ON DSK
	HRLZI	T3,OBUF		;BUFFER.
	OPEN	OUT,T1		;OPEN SESAME...
	  JRST	OPNERR		;JUST NOT MY DAY..
	SKIPN	T1,RELNAM	;USE THE SPECIFIED RELFILE NAME
	MOVE	T1,LOOKIT	;OR SOURCE FILE NAME
	CAMN	T1,[SIXBIT/-/]	;NO RELFILE?
	JRST	RESTRT		;QUIT
	SKIPN	T2,RELEXT	;SPECIFIED EXT.
	MOVSI	T2,'REL'	;OR DEFAULT
	SETZB	T3,T4
	ENTER	OUT,T1		;MAKE A RELFILE
	  JRST	ENTERR		;A LOSER
	MOVE	T1,[6,,1]	;ITEM TYPE 6 (NAME)
	PUSHJ	P,OUCH		;OUTPUT
	SETZ	T1,		;ZERO T1
	PUSHJ	P,OUCH		;
	MOVE	T1,R50NAM	;PROGRAM NAME
	PUSHJ	P,OUCH		;OUTPUT
	SETZM	LOC		;ZERO LOCATION COUNTER
	MOVE	T4,PROGRM	;GET OFFSET
	MOVE	T2,ENDLOC	;LAST LOC
GOLOOP:	CAIG	T2,21		;MORE THAN 1 BLOCK?
	JRST	LAST		;LAST
	PUSHJ	P,DOIT		;COMPUTE RELOCATION
	SUBI	T4,21		;GO BACK
	PUSHJ	P,WRITE		;DO THE DATA THING
	MOVEI	T1,21		;FULL 18 WORDS
	ADDM	T1,LOC		;INDEX.
	SUBI	T2,21		;LESS 1 BLOCK
	JRST	GOLOOP		;LOOP

DOIT:
	HRLZI	T1,1		;BLOCK TYPE 1
	HRRI	T1,22		;18 WORDS LONG
	PUSHJ	P,OUCH
	MOVEI	T3,21		;COUNTER
D1:	SETZ	T1,		;CLEAR WORD
	MOVE	P1,[POINT 2,T1]	;RELOC BYTE POINTER
	MOVEI	P2,1		;1ST IS RELOCATED
	IDPB	P2,P1		;STUFF.
LOOP:	CAML	T4,LITLOC	;ABOVE LITERALS?
	JRST	R00		;YES--ABSOLUTE
	HLLZ	P2,(T4)		;GET INSTR.
	MOVSI	P3,-ITABLN	;SET UP LOOP
	CAME	P2,ITAB(P3)	;MATCH?
	AOBJN	P3,.-1		;NO-LOOP
	JUMPL	P3,LOOP1	;MATCH, SKIP OTHER TEST
	MOVSI	P3,-STABLN	;SPECIAL TAB LENGTH
	MOVE	W,P2		;SAVE P2
	AND	P2,[777000,,0]	;MASK OPCODE
	CAME	P2,STAB(P3)	;GENERIC OPCODE MATCH?
	AOBJN	P3,.-1		;NO-LOOP
	JUMPGE	P3,R00		;NO MATCH, MUST BE ABS.
	MOVE	P2,W		;RESTORE P2
LOOP1:	TLNN	P2,20		;IF INDIRECT-END GLOBAL LINK
	SKIPA	P2,[1]		;WORD IS RELOC.
R00:	SETZ	P2,		;WORD IS ABS
	IDPB	P2,P1		;DEPOSIT RELOC
	AOJ	T4,		;NEXT LOCATION
	SOJG	T3,LOOP		;LOOP
	PUSHJ	P,OUCH		;WRITE RELOC WORD
	POPJ	P,		;RETURN.

WRITE:	MOVEI	T3,21		;17 WORDS OF DATA
	MOVE	T1,LOC		;GET BLOCK START ADDRESS
	PUSHJ	P,OUCH		;WRITE IT
	MOVE	T1,(T4)		;GET DATA
	CAMGE	T4,LITLOC	;DON'T CLOBBER LITERALS
	TLZ	T1,20		;CLEAR GLOBAL END LINK BIT
	PUSHJ	P,OUCH		;WRITE IT.
	AOJ	T4,		;NEXT WORD
	SOJG	T3,.-5		;LOOP
	POPJ	P,		;RETURN

LAST:	HRLZI	T1,1		;LINK ITEM TYPE 1
	HRR	T1,T2		;HOWEVER MANY LEFT
	AOJ	T1,		;+ 1 FOR BLOCK START ADDRESS
	PUSHJ	P,OUCH		;OUTPUT
	MOVE	T3,T2		;SAVE T2
	PUSHJ	P,D1		;COMPUTE RELOCATION
	SUB	T4,T2		;GO BACK
	MOVE	T1,LOC		;BLOCK START ADDRESS
	PUSHJ	P,OUCH		;WRITE IT
	MOVE	T1,(T4)		;GET DATA
	CAMN	T1,[PUSHJ 17,@0]
	TLZ	T1,20		;CLEAR INDIRECT BIT
	PUSHJ	P,OUCH		;WRITE IT.
	AOJ	T4,		;NEXT
	SOJG	T2,.-5		;LOOP

	SETZB	P1,P3		;RESET ACS
	SKIPE	SYMTAB(P3)	;EMPTY SYMBOL TABLE ENTRY?
	AOJA	P3,.-1		;NO,TRY AGAIN
SYMBOL:	CAIG	P3,22		;OVER 1 BLOCK?
	JRST	ENDSYM		;NO-1 BLOCK OR LESS
	SUBI	P3,22		;MINUS 1 BLOCK
	MOVE	T1,[2,,22]	;LINK ITEM TYPE 2 (SYMBOL)
	PUSHJ	P,OUCH		;
	MOVE	T1,[042104210421];RELOCATION WORD
	PUSHJ	P,OUCH		;
	MOVEI	P2,11		;9 SYMBOLS AT A SHOT
SYM1:	MOVE	T1,[POINT 6,SYMTAB(P1)]	;GET TAG
	PUSHJ	P,RDX51-1	;GET RADIX 50 SYMBOL IN T3
	MOVE	T1,T3		;TRANSFER SYMBOL
	AOJ	P1,		;2ND ITEM IN SYMBOL TABLE
	MOVE	T2,SYMTAB(P1)	;GET IT.
	AOJ	P1,		;NEXT
	MOVSI	T3,1B20		;ASSUME LOCAL SYMBOL
	TLNE	T2,1		;IS IT A GLOBAL SYMBOL REQUEST?
	MOVSI	T3,3B19		;YES
	TLNE	T2,2		;IS IT AN INTERNAL SYMBOL?
	MOVSI	T3,1B21		;YES
	TDO	T1,T3		;FLAG WHAT KIND OF SYMBOL
	PUSHJ	P,OUCH		;WRITE RADIX 50 SYMBOL
	HRRZ	T1,T2		;MOVE ADDRESS ONLY
	PUSHJ	P,OUCH		;WRITE SYMBOL ADDRESS
	SOJG	P2,SYM1		;LOOP FOR 9 SYMBOLS
	JRST	SYMBOL		;LOOP FOR NEXT BLOCK OF SYMBOLS

ENDSYM:	JUMPE	P3,ENDS1	;NO SYMBOLS = NO SYMBOL TABLE BLOCK
	HRLI	T1,2		;LINK ITEM TYPE 2 (SYMBOL)
	HRR	T1,P3		;NO. OF SYMBOLS & ADDRESSES
	PUSHJ	P,OUCH		;
	SETZ	T1,		;CLEAR T1
	MOVE	T1,[042104210421];FULL BLOCK RELOCATION
	MOVEI	T4,22		;ASSUME 22 WORDS
	SUB	T4,P3		;DIFFERENCE FROM # OF SYMBOLS
	IMULI	T4,2		;TIMES 2
	SETZ	T3,		;CLEAR MASK
	SETO	T2,		;INITIALIZE MASKER
	LSHC	T2,(T4)		;SHIFT THE BITS
	AND	T1,T2		;MASK OFF THE RELOCATION WORD
	PUSHJ	P,OUCH		;WRITE IT
	IDIVI	P3,2		;SYMBOLS/2
SYM2:	MOVE	T1,[POINT 6,SYMTAB(P1)]	;NEXT TAG
	PUSHJ	P,RDX51-1	;MAKE RADIX 50
	MOVE	T1,T3		;MOVE SYMBOL
	AOJ	P1,		;NEXT
	MOVE	T2,SYMTAB(P1)	;GET ADDRESS
	AOJ	P1,
	MOVSI	T3,1B20		;ASSUME LOCAL
	TLNE	T2,1		;GLOBAL?
	MOVSI	T3,3B19		;YES
	TLNE	T2,2		;LOCAL?
	MOVSI	T3,1B21		;YES
	TDO	T1,T3		;OVERLAY LOCAL,INTERNAL,OR GLOBAL
	PUSHJ	P,OUCH		;WRITE IT
	HRRZ	T1,T2		;MOVE ADDRESS
	PUSHJ	P,OUCH		;OUTPUT
	SOJG	P3,SYM2		;LOOP
ENDS1:	TRNE	F,FR.END	;DOES THIS PROGRAM HAVE A START ADDRESS?
	JRST	ENDREL		;NO-SKIP THE START ADDRESS
	MOVE	T1,[7,,1]	;LINK ITEM TYPE 7 (START ADDRESS)
	PUSHJ	P,OUCH		;WRITE IT.
	HRLZI	T1,200000	;RELOCATION
	PUSHJ	P,OUCH		;.
	SETZ	T1,		;START AT LOCATION 0
	PUSHJ	P,OUCH		;
ENDREL:	MOVE	T1,[5,,2]	;LINK ITEM TYPE 5 (END)
	PUSHJ	P,OUCH		;
	HRLZI	T1,200000	;RELOCATION WORD
	PUSHJ	P,OUCH		;
	MOVE	T1,ENDLOC	;1ST FREE LOCATION
	PUSHJ	P,OUCH		;
	SETZ	T1,		;1ST ABSOLUTE ADDRESS
	PUSHJ	P,OUCH		;SUPPRISE! THERE IS NONE.
	CLOSE	OUT,		;CLOSE REL FILE
	RELEAS	OUT,		;RELEASE CHANNEL
RESTRT:	TRZ	F,-1		;CLEAR ALL TEMP FLAGS
	JRST	START		;GO BACK TO COMAND SCANNER

OUCH:	SOSGE	OBUF+2
	JRST	.+3
	IDPB	T1,OBUF+1
	POPJ	P,
	OUT	OUT,
	JRST	OUCH
	OUTSTR	[ASCIZ/RELFILE I-O ERROR/]
	EXIT

ENTERR:	[ASCIZ/RELFILE ENTER ERROR
/]
	EXIT

OPNERR:	[ASCIZ/RELFILE OPEN ERROR
/]
	EXIT
;TABLE OF ALL PILOT OPCODES THAT HAVE RELOCATABLE ADDRESSES

ITAB:	MOVEI 1,
	OUTSTR
	IONEOU
	JRST
	JUMPE 1,
	JUMPN 1,
	SOJG 2,
	CALL.
	GETC.
	GETR.
	GETD.
	GETT.
	GETL.
	STRN.
	UNSTR.
	NMAT.
	NMATL.
	NMATG.
	ACCPT. 1,
	ACCPT. 2,
	ACCPT. 3,
	JUMP
	PUSHJ 17,
	TRAP.
	CJUMP.
	CPUSH.
	COMP.
	CPLUS.
	CMIN.
	CMULT.
	CDIV.
	INDEX.
	INDEX.	1,
ITABLN==.-ITAB

;TABLE OF OPCODES THAT ARE RELOCATABLE NO MATTER WHAT AC IS USED
STAB:	IN.
	OUT.
	GET.
	PUT.
STABLN==.-STAB

	END