/PALC ASSEMBLER FOR CAPS MONITOR	VERSION 2

/DEC-8E-OPALA-A-LA
/30 MARCH 1973				HJ
/COPYRIGHT 1972,1973  DIGITAL EQUIPMENT CORPORATION
/	MAYNARD, MASSACHUSETTS 01754

DECIMAL

VERSION=2

OCTAL

/PALC IS AN 8K THREE PASS ASSEMBLER DESIGNED
/TO BE COMPATIBLE WITH THE CAPS SYSTEM.

/PASS 1 READS THE INPUT (SOURCE) FILE AND CONSTRUCTS
/THE SYMBOL TABLE.

/PASS 2 GENERATES THE BINARY (OBJECT) FILE, WHICH
/MAY BE LOADED WITH THE ABSOLUTE (BINARY) LOADER.

/PASS 3 GENERATES THE OCTAL SYMBOLIC ASSEMBLY
/LISTING.

/PALC IS COMPATIBLE IN MOST RESPECTS WITH OS/8 PAL8-V7



/OPTIONS:
/K	CHECK FOR MORE THAN 8K OF CORE (DEFAULT IS 8K)
/S	NO SYMBOL TABLE	- ONLY IF LISTING
/N	NO LISTING	- ONLY IF LISTING
/D	DDT TYPE SYMBOL	- ONLY IF LISTING
/T	CR-LF NOT FF	- ONLY IF LISTING
/H	NO PAGING	- ONLY IF LISTING

/PSEUDO-OPS:
/DECIMAL	RADIX TO BASE 10
/EJECT		CAUSES A SKIP TO A NEW PAGE, AND IF
/		THE EJECT IS FOLLOWED BY TEXT, THAT TEXT BECOMES
/		THE NEW HEADER LINE
/ENPUNCH	ENABLE PUNCHING
/EXPUNGE	REMOVE ALL SYMBOLS
/FIELD		SET FIELD
/FIXMRI		DEFINE MEMORY REFERENCE INSTRUCTION
/FIXTAB		MAKE ALL SYMBOLS PERMANENT
/IFDEF		CONDITIONAL ON DEFINITION
/IFNDEF		CONDITIONAL ON UNDEFINED
/IFNZRO		CONDITIONAL ON NON-ZERO
/IFZERO		CONDITIONAL ON ZERO
/NOPUNCH	DISABLE PUNCHING
/OCTAL		RADIX TO BASE 8
/PAGE		RE-ORIGIN TO BEGINNING OF NEXT PAGE OR PAGE N
/PAUSE		ALTERNATE END-OF-FILE
/TEXT		6 BIT TEXT
/XLIST		LISTING INHIBIT UNLESS THE XLIST IS
/		FOLLOWED BY AN EXPRESSION. THEN IF THE EXPRESSION
/		IS 0 START LISTING, OR NON-0 THEN INHIBIT LISTING
/ZBLOCK		RESERVE BLOCK OF ZEROS


/SYMBOL LAYOUT:
/	WORD 1	BIT 0=1	PERMANENT SYMBOL
/		BIT 1=1	"I" OR "Z"
/		BITS 3-11	CHARS 1 AND 2
/
/	WORD 2	BIT 0=1	MEMORY REFERENCE INSTRUCTION
/		BITS 2-11	CHARS 3 AND 4
/
/	WORD 3	BIT 0=1	PSEUDO-OP
/		BITS 2-11	CHARS 5 AND 6
/
/	WORD 4	BITS 0-11	OCTAL VALUE
/CHARS ARE STORED AS:
/	A TO Z ARE 01 TO 32
/	0 TO 9 ARE 33 TO 44
/
/	CHAR1^45+CHAR2

/OPERATORS:
/+		TWO'S COMPLEMENT ADD
/-		TWO'S COMPLEMENT SUBTRACT
/&		BOOLEAN AND
/!		BOOLEAN INCLUSIVE OR
/  (SPACE)	DELIMITER OR INCLUSIVE OR
/^		MULTIPLY (REPEATED ADDITION)
/%		DIVIDE (REPEATED SUBTRACTION)

/DEFINITIONS

	FIXMRI	CALL=4400

/TABLE OF ERROR MESSAGE DEFINITIONS

IZ="I-240^100+"Z-240	/ILLEGAL PAGE ZERO REFERENCE
US="U-240^100+"S-240	/UNDEFINED SYMBOL
IP="I-240^100+"P-240	/ILLEGAL PSEUDO-OP USAGE
SE="S-240^100+"E-240	/SYMBOL TABLE EXCEEDED
ZE="Z-240^100+"E-240	/PAGE ZERO EXCEEDED
PE="P-240^100+"E-240	/CURRENT PAGE EXCEEDED
IC="I-240^100+"C-240	/ILLEGAL CHARACTER
ID="I-240^100+"D-240	/ILLEGAL DEFINITION
BE="B-240^100+"E-240	/PUSH-DOWN OVERFLOW
DE="D-240^100+"E-240	/DEVICE ERROR
DF="D-240^100+"F-240	/DEVICE FULL
IE="I-240^100+"E-240	/ILLEGAL EQUATE
PH="P-240^100+"H-240	/PHASE ERROR
II="I-240^100+"I-240	/ILLEGAL INDIRECT
RD="R-240^100+"D-240	/REDEFINITION
UO="U-240^100+"O-240	/UNDEFINED ORIGIN


/ABBREVIATIONS
/CR/LF	CARRIAGE RETURN/LINE FEED (215,212)
/F/F	FORM FEED (214)

/ MONITOR INTERFACE LOCATIONS
	KBDIN=7602	/LAST CHARACTER TYPED
	LOOKUP=7002	/LOOKUP A FILE
	UTIL=7200	/CASSETTE FUNCTIONS ROUTINE
	BSIZE=7000	/SIZE OF DATA BLOCK
	HANDLER=6600	/ENTRY POINT OF HANDLER
	CLOSE=6400	/CLOSE OUTPUT FILE
	TTOCHR=7402	/TYPE CHAR ROUTINE
	KBDCHR=7626	/INPUT A CHAR ROUTINE
	WAIT=6200	/WAIT FOR I/O COMPLETE
	ENTER=6404	/CREATE OUTPUT FILE
	TTCHCT=7413	/NUMBER OF CHARS WAITING TO TYPE
	TTSIZE=30	/INITIAL SIZE OF BUFFER
	TTSIZ=7410	/TOTAL SIZE OF BUFFER
	LPCHCT=7406	/NUMBER OF CHARS WAITING TO PRINT
	LPSIZE=2	/INITIAL SIZE OF BUFFER
	LPSIZ=7414	/LOCATION CONTAINING COUNT OF BUFFER SPACE
	LPOCHR=7400	/SUBROUTINE FOR LINE PRINTER
	TTBUFR=7734	/BEGINING OF TELETYPE BUFFER
	LPBUFR=7731	/BEGINING OF LINE PRINTER BUFFER
	SINCH=7403	/SPOT FOR OUTPUT FILENAME FOR ENTER
	BLSIZE=200	/SIZE OF CASSETE BLOCK
	HDSIZE=40	/SIZE OF STANDARD HEADER RECORD
	MPARAM=7400	/MONITOR OPTIONS WORD 1
	DATEWD=7531	/MONITOR DATE LOCATION
	BVERNO=SINCH+24	/VERSION NUMBER OF BINARY FILE

/PAGE ZERO

*4
FORMF6,	0		/USED IN DECIMAL PRINT ROUTINE
FORMF7,	0		/FOR STORAGE
LISOU2,	0		/STORAGE DURING PASS 3 OUTPUT
LEADER,	-10		/LEADER-TRAILER CONSTANT

/AUTOINDEX REGISTERS
/PRESET FOR ONCE ONLY CODE

	*10
PDLXR,	PDLST		/PUSH-DOWN AUTO INDEX REGISTER
TAGXR,	0		/TAG AUTO INDEX REGISTER
XREG1,	DSWIT1-1	/GENERAL AUTO INDEX REGISTER
XREG2,	DSWIT2-1	/GENERAL AUTO INDEX REGISTER

/NOT USED AS AUTO INDEX REGISTERS
/EXCEPT DURING ONCE ONLY CODE
LAST1,	DATE-1		/LAST DEFINED SYMBOL
LAST2,	DATEWD-1
LAST3,	SYMPRT+3-1
LAST4,	SYMPR9-2-1

	*20
TAG1,	0		/TAG STORAGE
TAG2,	0
TAG3,	0

LITPTR,	200		/LITERAL POINTER

RADIX,	0		/NON-ZERO IF DECIMAL MODE
PUNCHX,	0		/NON-ZERO IF NO PUNCHING
XLISTX,	0		/NON-ZERO IF NO LISTING
/*NOTE* PUNCHX AND XLISTX MUST BE TOGETHER
/AND IN THIS ORDER

LOC,	200		/CURRENT LOCATION

OP,	0		/LAST OPERATOR CODE (0-6)
VALUE,	0		/EXPRESSION VALUE
VALUE2,	0		/EXPRESSION OPERAND

TXTSWT,	0		/SPACE SWITCH
TXTPTR,	LINBUF+120	/TEXT POINTER
CHAR,	0		/CURRENT CHARACTER

THISPG,	0		/OVERFLOW PAGE
EDITPG,	0		/EDITOR PAGE


TEMP,	0		/TEMPORARY REGISTERS
TEMP1,	0
TEMP2,	0
TEMP3,	0
OCHAR,	OUTPUT		/OUTPUT ROUTINE
ICHAR,	INPUT		/INPUT ROUTINE
OERROR,	OTYPEO		/PASS 1=OTYPEO; 2=OTYPEO; 3=LISOUT
PASS,	-2		/-1 IF PASS 1
			/0 IF PASS 2
			/1 IF PASS 3
IOMON,	200		/USER SERVICE ROUTINES
CONDSW,	0		/NUMBER OF NESTED CONDITIONALS
EXPIND,	0		/0 IF MRI OK HERE
			/NOT 0 IF MRI NOT OK HERE
CHKSUM,	0		/BINARY CHECK SUM
IZIND,	0		/"I" AND "Z" INDICATOR
			/IF I, LEFT 6 BITS ARE NON-ZERO
			/IF Z, RIGHT 6 BITS ARE NON-ZERO
THISTG,	0		/ASSIGNED NUMBER OF CURRENT TAG
HIGHTG,	SYME-SYMS-4%4	/ASSIGNED NUMBER OF LAST TAG
LINCNT,	0		/LINE COUNT
ALPHAI,	0		/UNDEFINED TAG INDICATOR
			/-1 IF UNDEFINED
GETCI,	0		/NOT=0 IF ONLY CARRIAGE RETURN ENDS LINE
			/OTHERWISE /,;, OR CARRIAGE RETURN ENDS
LSTCNT,	0		/TAB COUNTER
UNDFSW,	0		/UNDEFINED SWITCH
LINKSW,	0		/OFF-PAGE LINK SWITCH
			/0 IF NO LINK GENERATED
			/0700 IF LINK
LININD,	0		/BACK-UP FOR LINKSW
PERROR,	PERRO1		/DUMMY ERROR ROUTINE TO SUPPRESS CERTAIN
			/MESSAGES DURING PASS 1
FLDIND,	"0		/CURRENT FIELD IN ASCII DIGIT FORM
PTR,	0
KNT,	0
CNT,	0
SPTR,	0
IPTR,	0
UNIT,	0

	PAGE


/STARTING ADDRESS OF PAL8 (0200)
/CHAINING ADDRESS (0201)

NAME1,	CLA CLL		/NAME1-NAME3 USED LATER
NAME2,	JMP I .+1	/TO STORE TAGS AS THEY ARE BUILT
NAME3,	BEGIN
GETTA2,	0		/BUILDING SWITCH AND OVERFLOW PROTECT


/HANDLERS FOR NOPUNCH AND ENPUNCH PSEUDO-OPS

NOPUNX,	CLA IAC		/NON-ZERO FOR NO PUNCHING
ENPUNX,	DCA PUNCHX	/ZERO FOR PUNCHING
	JMP I [LOOKEX	/--EXIT TO MAIN--


/HANDLERS FOR DECIMAL AND OCTAL PSEUDO-OPS

DECIMX,	CLA IAC		/NON-ZERO FOR DECIMAL RADIX
OCTALX,	DCA RADIX	/ZERO FOR OCTAL RADIX
	JMP I [LOOKEX	/--EXIT TO MAIN--


/**********************************************************
/GET A TAG ROUTINE
/PICKS UP A TAG AND SEARCHES FOR IT
/"THISTG" HAS NUMBER OF TAG
/"VALUE2" HAS VALUE
/SKIPS IF FOUND

GETTAG,	0
	DCA NAME1	/CLEAR BUILD AREA
	DCA NAME2
	DCA NAME3
	TAD [NAME1-1
	DCA GETTA4	/SET POINTER FOR BUILDING
	DCA GETTA2	/ZERO SWITCH
GETTG1,	TAD CHAR	/GET THE CHARACTER
	AND [77		/MAKE IT 01-32 OR 60-71
	TAD (-32	/WAS IT A TO Z?
	SMA SZA
	TAD (-25	/NO - MAKE 60-71 INTO 33-44
	TAD (32		/YES - IT IS NOW 01-32 OR 33-44
	ISZ GETTA2	/LEFT SIDE?
	JMP GETTA3	/YES
	TAD I GETTA4	/NO - RIGHT SIDE
	DCA I GETTA4	/BUILD THE WORD
GETTA1,	JMS I [GETC	/GET NEXT CHARACTER
	JMS I [TSTALN	/IS IT ALPHANUMERIC?
	JMP GETTG1	/YES - KEEP BUILDING
	TAD HIGHTG	/NO - GET NUMBER OF HIGHEST TAG
	CLL RAR		/DIVIDE BY 2
	DCA TEMP2	/SAVE DIFFERENCE
	DCA THISTG	/START AT TAG ZERO
	CLL CML		/LINK MUST BE ON INITIALLY
	DCA TEMP1


/GETTA4 IS POINTER TO NAME1-NAME3
/FOR DEPOSITING TAG AS IT IS BUILT

/TEMP2 IS # OF TAGS TO SKIP BETWEEN CHECKS FOR MATCH
/DURING BINARY SEARCHING



GETTG2,	SZL		/IS THISTG HIGHER THAN TAG?
	JMP GETTG3	/NO-LOWER
GETTG4,	DCA TEMP1	/CLEAR LAST TIME SWITCH
	SNL
	ISZ TEMP1	/SET LAST TIME SWITCH TO 1
	TAD TEMP2	/GET # OF TAGS TO SKIP
	SNL
	CIA
	TAD THISTG	/INCREASE OR DECREASE TAG NUMBER
	DCA THISTG
	TAD TEMP2	/GET NUMBER
	CLL RAR		/DIVIDE BY 2
	SNA		/IS RESULT 0?
	ISZ TEMP1	/YES-BUMP LAST TIME SWITCH
	SNA
	IAC		/IF RESULT WAS 1, MAKE IT 2
	DCA TEMP2	/SAVE IT FOR NEXT TIME
	JMS I [FINDTG	/GET THE TAG
	TAD [1777	/MASK
	AND TAG1	/GET WORD 1
	CLL CIA
	TAD NAME1	/DOES IT MATCH?
	SZA CLA
	JMP GETTG2	/NO - TRY NEXT TAG
	CLL CLA CMA RAR	/AC=3777
	AND TAG2	/YES - GET WORD 2
	CLL CIA
	TAD NAME2	/DOES IT MATCH?
	SZA CLA
	JMP GETTG2	/NO - TRY NEXT TAG
	CLL CLA CMA RAR	/AC=3777
	AND TAG3	/YES - DOES IT MATCH?
	CLL CIA
	TAD NAME3
	SZA CLA
	JMP GETTG2	/NO - TRY NEXT TAG
	ISZ GETTAG	/YES - INCREMENT RETURN ADDRESS-MATCH
	JMP I GETTAG	/--RETURN--


GETTG3,	CLL CLA CMA RAL	/AC=7776
	TAD TEMP1	/LAST TIME SWITCH = 2?
	SZA CLA
	JMP GETTG4	/NO-KEEP TRYING
	ISZ THISTG	/YES-QUIT SEARCHING
	DCA VALUE2
	DCA TAG1
	DCA TAG2
	DCA TAG3	/TAG NOT FOUND
	JMP I GETTAG	/--RETURN--


GETTA3,	ISZ GETTA4	/BUMP POINTER
	DCA I GETTA4	/SAVE TIMES 1
	TAD I GETTA4
	CLL RTL		/TIMES 4
	DCA GETTA2	/SAVE TIMES 4
	TAD GETTA2
	CLL RTL		/TIMES 20
	RAL		/TIMES 40
	TAD GETTA2	/40+4 = TIMES 44
	TAD I GETTA4	/44+1 = TIMES 45
	DCA I GETTA4	/SET LEFT SIDE
	TAD GETTA4
	TAD (-GETTA2
	RAL
	CLA CML CMA RAL	/-1 IF TOO MANY; -2 IF O.K.
	DCA GETTA2
	ISZ GETTA2
	JMP GETTA1
	CLA CMA
	TAD GETTA4
	DCA GETTA4	/BACK UP POINTER
	JMP GETTA1

GETTA4,	NAME1-1

/IGNORE SPACES ROUTINE

SPNOR,	0
	TAD CHAR	/GET THE CHARACTER
	TAD [-240	/IS IT A SPACE?
	SZA CLA
	JMP I SPNOR	/NO --RETURN--
	JMS I [GETC	/YES - GET NEXT CHARACTER
	JMP SPNOR+1	/LOOP


/HANDLER FOR PAUSE PSEUDO-OP
/END-OF-TAPE OR END-OF-FILE

PAUSEX,	CLL CLA CML RAR	/AC=4000
	DCA CHAR	/SET END-OF-LINE CHARACTER
	TAD [LINBUF+120	/REINITIALIZE TEXT POINTER
	DCA TXTPTR
	CLA CMA
	DCA I (INCHCT	/INDICATE EMPTY BUFFER
	ISZ I (INEOF	/SET END-OF-FILE
	JMP I [LOOKEX	/--EXIT TO MAIN--

	PAGE


/HANDLER FOR ZBLOCK PSEUDO-OP
/RESERVES AS MANY WORDS OF ZERO
/AS VALUE OF EXPRESSION

ZBLOCX,	JMS I [SPNOR	/IGNORE SPACES
	JMS I [EXP	/GET THE EXPRESSION
	TAD VALUE	/WAS IT ZERO?
	CIA
	SNA
	JMP I [LOOKEX	/YES--EXIT TO MAIN--
	DCA TEMP3	/NO - STORE NEGATIVE AS COUNTER
ZBLOCY,	JMS I [PUNBIN	/OUTPUT ONE WORD OF ZERO
	TAD PASS	/IS THIS PASS 3?
	SMA SZA CLA
	DCA I (PUNMOD	/YES - PREVENT OUTPUT
	ISZ TEMP3	/NO - DONE YET?
	JMP ZBLOCY	/NO - CONTINUE
	TAD (JMS I [PUNONE	/YES - RESTORE PUNMOD
	DCA I (PUNMOD
	JMP I [LOOKEX	/--EXIT TO MAIN--


/HANDLER FOR FIELD PSEUDO-OP

FIELDX,	JMS I [SPNOR	/IGNORE SPACES
	JMS I [DUMPS	/DUMP CURRENT PAGE LITERALS
	JMS I [DUMPZ	/DUMP PAGE ZERO LITERALS
	JMS I [EXP	/GET EXPRESSION
	TAD VALUE	/TRIM TO RIGHT 3 BITS
	JMS I (FIELDA	/SET FIELD DIGIT OF ADDRESS
	TAD PASS	/IS THIS PASS 2?
	SZA CLA
	JMP FIELDY	/NO - PREPARE TO EXIT
	TAD VALUE	/YES - GET FIELD NUMBER
	CLL RTL
	RAL		/AND CHANNELS 7 AND 8
	TAD [7700
	JMS I OCHAR	/OUTPUT FIELD SETTING
FIELDY,	JMS I [CLEAN	/CLEAN UP THINGS
	TAD [200	/RESET ORIGIN TO 200
	JMP STAR1




/HANDLER FOR PAGE PSEUDO-OP

PAGEX,	JMS I [DUMPS	/DUMP SAME PAGE LITERALS
	JMS I (XLISTZ	/ANY EXPRESSION?
	JMP PAGEY	/NO
	JMS I [EXP	/YES - GET EXPRESSION
	TAD VALUE
	JMS I [RTL6
	RAL		/GET PAGE NUMBER
	JMP STAR1-3

PAGEY,	TAD LOC		/NO ARGUMENT - FIND NEXT PAGE
	TAD [177
	AND [7600
	DCA VALUE
	TAD VALUE	/GET START OF PAGE
STAR1,	JMS I [PUNORG	/PUNCH ORIGIN
	JMS I [FINDSP
	TAD [LITBUF	/RESET POINTERS
	DCA TEMP
	TAD I TEMP
	DCA LITPTR	/INITIALIZE LITERAL POINTER FOR NEW PAGE
	DCA LAST1
	JMP I [PUNVAL	/SEE ABOUT DUMPING SOURCE CODE


/HANDLER FOR =

EQUAL,	ISZ ALPHAI	/WAS TAG ALREADY DEFINED?
	SKP
	JMS I [INSRTG	/NO - PUT TAG INTO SYMBOL TABLE
EQUAL3,	JMS I [GETC	/GET NEXT CHARACTER
	TAD THISTG
	JMS I [PUSHA	/STORE TAG NUMBER
	TAD ALPHAI
	JMS I [PUSHA	/STORE UNDEFINED INDICATOR
	JMS I [SPNOR	/IGNORE SPACES
	JMS I [EXP	/GET EXPRESSION TO RIGHT OF =
	TAD I PDLXR
	DCA ALPHAI	/RESTORE UNDEFINED INDICATOR
	TAD I PDLXR
	DCA THISTG	/RESTORE TAG NUMBER
	JMS I [FINDTG
	ISZ UNDFSW	/WAS ANY PART OF DEFINITION UNDEFINED?
	JMP .+3
	JMS I PERROR	/YES - GENERATE IE ERROR MESSAGE
	IE
	TAD ALPHAI	/NO - HAD TAG BEEN DEFINED BEFORE?
	SNA CLA
	JMP EQUAL2	/NO
	TAD VALUE	/YES - WERE DEFINITIONS THE SAME?
	CIA
	TAD VALUE2
	SNA CLA
	JMP EQUAL2	/YES
	TAD TAG1	/NO - IS IT A PERMANENT SYMBOL?
	SMA CLA
	JMP EQUAL2	/NO - OK TO REDEFINE
	JMS I [ERROR	/YES - GENERATE RD ERROR MESSAGE FIRST
	RD
EQUAL2,	TAD VALUE	/DEFINE OR REDEFINE
	DCA VALUE2
	JMS I [PUTTAG	/STORE TAG
	JMP I [PUNVAL	/SEE ABOUT DUMPING SOURCE CODE



/HANDLER FOR FIXMRI PSEUDO-OP

FIXMRX,	JMS I [SPNOR	/IGNORE SPACES
	JMS I [TSTALP	/IS CHARACTER ALPHABETIC?
	JMP FIXMR1	/YES-CONTINUE
	JMS I [ERROR	/NO GENERATE IC ERROR MESSAGE
	IC
	TAD CHAR	/GET CHARACTER
	SPA CLA		/WAS IT END OF LINE?
	JMP I [LOOKEX	/YES--EXIT TO MAIN--
	JMS I [GETC	/NO-GET NEXT CHARACTER
	JMP FIXMRX+1	/KEEP LOOKING FOR ALPHABETIC CH. OR END OF LINE
FIXMR1,	JMS I [GETTAG	/PICK UP TAG-IS SYMBOL IN TABLE?
	JMP FIXMR3	/NO-PUT IT IN
	CLA CMA		/YES-CLEAR UNDEFINED TAG SWITCH
	DCA ALPHAI
	TAD TAG2	/SET BIT FOR MEMORY REFERENCE INSTRUCTION
	CLL RAL
	CLL CML RAR
	DCA TAG2
	JMS I [PUTTAG	/STORE TAG
	JMS I [SPNOR	/IGNORE SPACES
FIXMR2,	TAD CHAR	/END OF LINE
	SPA CLA
	JMP I [LOOKEX	/YES--EXIT TO MAIN--
	TAD CHAR	/NO-WAS CHARACTER = ?
	TAD (-"=
	SNA CLA
	JMP EQUAL3	/YES-CONTINUE
	JMS I [ERROR	/NO GENERATE IC ERROR MESSAGE
	IC
	JMS I [GETC	/IGNORE ILLEGAL CHARACTER
	JMP FIXMR2	/GET NEXT ONE

FIXMR3,	JMS I [INSRTG	/PUT SYMBOL IN TABLE
	JMP FIXMR1+3

	PAGE


/ROTATE AC 6 LEFT

RTL6,	0
	CLL RTL
	RTL
	RTL
	JMP I RTL6	/--RETURN--


/GET NEXT CHARACTER ROUTINE
/READS FROM THE INPUT FILES AND PASSES THE MODIFIED CHARACTERS
/TO THE PROGRAM
/IT ALSO PRINTS THE LATEST LINE IF IT HAS NOT BEEN PRINTED

GETC,	0
	ISZ TXTPTR	/POINT TO NEXT CHARACTER
GETC7,	TAD I TXTPTR	/GET NEXT CHARACTER
	SZA		/IS IT 0?
	JMP GETC8	/NO - MORE ARE IN THIS LINE
	TAD PASS	/IS THIS PASS 3?
	SPA SNA CLA
	JMP GETC1	/NO
	TAD [LINBUF	/YES
	DCA TXTPTR	/RESET POINTER TO BEGINNING
	TAD I TXTPTR	/GET 1ST CHARACTER
	SNA		/IS IT 0?
	JMP GETC1	/YES - LINE HAS BEEN PRINTED
	TAD [-215	/IS IT 215?
	SNA CLA
	JMP GETC2	/YES - DO NOT PRINT THE SPACES
	TAD [211	/NO-OUTPUT 2 TABS
	JMS I OERROR
	TAD [211
	JMS I OERROR
GETC2,	JMS LINPRT	/NOW PRINT THE LINE
GETC1,	TAD (-121
	DCA TXTSWT
	TAD [LINBUF-1
	DCA TXTPTR	/RESET POINTER
	ISZ TXTPTR
GETC6,	JMS I ICHAR	/GET NEXT CHARACTER
	JMP GETC4	/215
	DCA I TXTPTR	/STORE THE CHARACTER
	ISZ TXTSWT	/TOO MANY?
	JMP GETC6-1	/NO
	CLA CMA		/YES
	DCA TXTSWT
	JMP GETC6



GETC4,	DCA I TXTPTR	/SET END
	ISZ TXTPTR
	DCA I TXTPTR	/SET END OF LINE
	TAD [LINBUF
	DCA TXTPTR	/RESET POINTER
	CLA CMA
	DCA TXTSWT	/RESET SWITCH
	JMP GETC7	/GET THAT CHARACTER

GETC8,	TAD [-215	/IS IT A CARRIAGE RETURN?
	SNA
	JMP GETC12	/YES-END OF LINE
	TAD GETCI	/NO-
	TAD (215-"/	/IS IT A /?
	SNA		/YES-
	JMP GETC13	/"/" IS END
	TAD ("/-";	/IS IT A ;?
	SNA		/YES-
	JMP GETC12	/";" IS END
	TAD (";-211	/IS IT A TAB?
	SNA
	JMP GETC10	/YES- TAB IS SPACE
	TAD (211-240	/IS IT SPACE?
	SZA CLA
	JMP GETC9	/NO-NOT ANYTHING SPECIAL
GETC10,	ISZ TXTSWT	/YES-2ND OCCURANCE?
	JMP GETC+1	/YES - IGNORE
	TAD [240
	DCA CHAR	/NO - GIVE A SPACE
	JMP I GETC	/--RETURN--

GETC16,	ISZ CONDSW	/DECREMENT CONDITIONAL COUNTER
	JMP GETC15
GETC17,	TAD [LINBUF+120
	DCA TXTPTR
GETC12,	CLL CLA CML RAR	/AC=4000
GETC9,	TAD I TXTPTR
	DCA CHAR	/STORE CHARACTER
	CLA CMA
	DCA TXTSWT	/SET THE SWITCH
	JMP I GETC	/--RETURN--



GETC13,	TAD CONDSW	/CURRENTLY IN CONDITIONALS?
	SNA CLA
	JMP GETC17	/NO
GETC15,	ISZ TXTPTR	/YES-SCAN LINE FOR < AND >
	TAD I TXTPTR
	TAD [-215	/IS CHARACTER A CARRIAGE RETURN?
	SNA
	JMP GETC17	/YES
	TAD (215-">	/NO IS IT A >?
	SNA
	JMP GETC16	/YES
	TAD (">-"<	/NO-IS IT <?
	SZA CLA
	JMP GETC15	/NO
	CLA CMA		/YES-INCREMENT CONDITIONAL COUNTER
	TAD CONDSW
	DCA CONDSW
	JMP GETC15


/CHAR IS NEGATIVE IF LOGICAL END OF LINE:
/	CARRIAGE RETURN
/	/
/	;

/CHAR MAY BE ZERO IF PHYSICAL END OF LINE:
/	CARRIAGE RETURN

/PRINT A LINE OF SOURCE CODE

LINPRT,	0
	TAD (LINBUF-1
	DCA XREG1	/SET POINTER TO LINE
LINPR1,	TAD I XREG1	/GET CHARACTER
	SNA		/IS IT END OF LINE?
	JMP LINPR2	/YES - END LINE
	JMS I OERROR	/NO - OUTPUT CHARACTER
	JMP LINPR1

LINPR2,	DCA I [LINBUF	/0 MEANS THAT LINE HAS BEEN PRINTED
	JMP I LINPRT	/--RETURN--


/HANDLE PHASE ERROR
/AND ALL ERROR EXITS TO MONITOR

PHASE,	TAD (PH		/GENERATE PH ERROR MESSAGE
MONERR,	DCA MONER1	/ERROR IS SERIOUS ENOUGH TO
	TAD [OTYPEO	/ CAUSE IMMEDIATE RETURN TO
	DCA OERROR	/ MONITOR
	JMS I [ERROR
MONER1,	0		/STORE ERROR TYPE HERE
	JMP MONWT	/***EXIT TO MONITOR***


/FIND CURRENT PAGE NUMBER
/EXIT WITH NUMBER IN AC

FINDSP,	0
	TAD LOC
	AND [7600
	JMS I [RTL6
	JMP I FINDSP	/--RETURN--

	PAGE



/PASS 3 LISTING OUTPUT

LISOUT,	0
	DCA LISOU2
	TAD XLISTX	/IS THIS COVERED BY XLIST?
	SZA CLA
	JMP I LISOUT	/YES--RETURN--
	ISZ LISCNT	/NO-WAS PREVIOUS CHARACTER A 215?
	JMP LISOU1	/NO
	ISZ LINCNT	/WAS IT END OF PAGE?
	JMP LISOU1	/NO
	ISZ THISPG	/YES-START OVERFLOW PAGE
BEGIAB,	JMS CRLF	/OUTPUT CARRIAGE RETURN/LINE FEED
HSWIT1,	JMS I [FORMFD	/0 IF /H SWITCH OPTION TO SUPRESS PAGING
	ISZ LINCNT
LISOU1,	TAD LISOU2	/IS CHARACTER A CARRIAGE RETURN?
	TAD [-215
	SNA
	JMP LISOU3	/YES - OUTPUT CR/LF
	TAD [215	/NO - RESTORE CHARACTER
	JMS I OCHAR	/OUTPUT CHARACTER
	JMP I LISOUT	/--RETURN--

LISOU3,	CLA CMA
	DCA LISCNT	/REMEMBER THE 215 FOR NEXT TIME
	JMS CRLF	/OUTPUT CARRIAGE RETURN/LINE FEED
	JMP I LISOUT	/--RETURN--

LISCNT,	-1


/FORM FEED OUTPUT ROUTINES

FORMFD,	0
	TAD XLISTX	/IS THIS COVERED BY XLIST?
	SZA CLA
	JMP I FORMFD	/YES--RETURN--
HSWITC,	JMP FORMF1	/0 IF /T OR TTY:; JMP FORMF3 IF /H
			/OUTPUT IF TTY:OR /T OPTION
	TAD LINCNT
	TAD [-4
	DCA LINCNT
	JMS CRLF	/OUTPUT CARRIAGE RETURN/LINE FEED
	ISZ LINCNT
	JMP CRLF1	/OUTPUT LINE FEED
			/CRLF1 WILL RETURN TO
			/JMP-1 UNTIL LINCNT HAS
			/BEEN BUMPED SUFFICIENTLY
	TAD FORMM6
	DCA LINCNT
	TAD ["-		/OUTPUT ------
	JMS I OCHAR
	ISZ LINCNT
	JMP .-3
	TAD [-4
	DCA LINCNT
			/OUTPUT IF NO OPTIONS SPECIFIED
			/LINCNT=-1
FORMF2,	JMS CRLF	/OUTPUT CARRIAGE RETURN/LINE FEED
	ISZ LINCNT
	JMP CRLF1	/OUTPUT LINE FEED
	TAD FORM70
	DCA LINCNT


FORM22,	TAD [HEADER-1	/OUTPUT HEADER
	DCA XREG2
	TAD [40
	DCA LSTCNT
FORM30,	TAD I XREG2	/GET NEXT CHARACTER OF HEADING
	SNA		/IS IT LAST + 1
	JMP FORM20	/YES
	JMS I OCHAR	/NO-OUTPUT IT
	TAD LSTCNT
	TAD [-100	/DONE 40 CHARACTERS YET?
	SZA CLA
	JMP FORM30	/NO-CONTINUE
	TAD [40		/YES-START SYSTEM HEADER
	JMP FORM22	/WHICH STARTS AT HEADER+40


/TTY: OR /T OUTPUTS FORM FEED AS
/CARRIAGE RETURN, MULTIPLE LINE FEEDS TO END OF PAGE
/------
/CARRIAGE RETURN, 5 LINE FEEDS
/HEADER
/NO OPTIONS TREATS F/F AS
/F/F, LF, CR/LF
/HEADER

/ /H OPTION TREATS F/F AS 2 CR/LF

/USER HEADER IS 40 (8) CHARACTERS WIDE
/ASSEMBLER HEADER ENDS WITH 0


/OUTPUT PAGE NUMBERS

FORM20,	TAD EDITPG	/OUTPUT EDITOR PAGE NUMBER
	JMS FORMF4
	TAD THISPG	/IS THERE PAGE OVERFLOW?
	SNA CLA
FORM21,	JMP FORMF3	/NO
	TAD ["-		/YES
	JMS I OCHAR	/OUTPUT -
	TAD THISPG	/OUTPUT NUMBER OF OVERFLOW PAGE
	JMS FORMF4
			/OUTPUT IF /H OPTION
FORMF3,	JMS CRLF	/OUTPUT 2 CR/LF
	JMS CRLF
	JMP I FORMFD	/--RETURN--


/DECIMAL PRINT ROUTINE

FORMF4,	0
	DCA FORMF6	/SAVE NUMBER
	TAD FORM8F
	DCA CRLF	/POINT TO DIVISION LIST
	CLL CLA CMA RTL	/AC=7775
	DCA FORM11	/DIVIDE BY 1000, 100, OR 10
FORM12,	DCA FORMF7	/START WITH 0
	JMP .+3
FORMF5,	DCA FORMF6
	ISZ FORMF7	/ADD 1 TO DIGIT
	TAD FORMF6
	TAD I CRLF	/SUBTRACT 1000, 100, OR 10
	SMA		/OVERFLOW
	JMP FORMF5	/NO-KEEP SUBTRACTING
	CLA		/YES-DIGIT DONE
	ISZ CRLF	/BUMP LIST POINTER
	TAD FORMF7	/WAS DIGIT A 0?
	SNA
	JMP FORM10	/YES
	TAD ["0		/NO-MAKE IT ASCII
	JMS I OCHAR	/OUTPUT DIGIT
	CLL CLA CML RAR	/AC=4000
FORM10,	ISZ FORM11	/DONE?
	JMP FORM12	/NO-4000 IN AC WILL FORCE SIGNIGICANCE
	TAD FORMF6	/GET LAST DIGIT (UNITS PLACE)
	TAD ["0
	JMS I OCHAR	/OUTPUT DIGIT
	JMP I FORMF4	/--RETURN--

FORMF1,	CLL CLA CMA
	DCA LINCNT
	CLA CMA		/ENTER CRLF WITH AC=-1
	JMP FORMF2	/TO GENERATE F/F LF

FORMM6,	-6
FORM70,	-70
FORM8F,	FORMF8
FORM11,	0


/OUTPUT CARRIAGE RETURN/LINE FEED
/ENTER WITH AC=-1 TO GENERATE F/F LF

CRLF,	0
	TAD [215
	JMS I OCHAR
CRLF1,	TAD [212	/RE-ENTRY FOR MULTIPLE LINE FEEDS
	JMS I OCHAR
	JMP I CRLF	/--RETURN--


	PAGE


/SYMBOL TABLE OUTPUT (COLUMNAR)
		/*CODE TO GENERATE DDT COMPATIBLE*
		/**SYMBOL TABLE--SUBSTITUTED WITH*
		/**ONCE ONLY CODE IF NEEDED*******

SYMPRT,	0
	ISZ THISPG			/FORM FEED
	JMS I [FORMFD
	TAD [-67	/DCA I SYMPR6-1
	DCA SYMPR7	/JMS SYMPR9+6
SYMPR8,	DCA SYMPR2	/TAD [377	//RUBOUT
	CLA CMA		/JMS I OERROR
	DCA THISTG	/CLA CMA
	TAD SYMPR2	/DCA THISTG
	CMA		/TAD [215	//CARRIAGE RETURN
	DCA SYMPR3	/JMS I OERROR
SYMPR5,	ISZ SYMPR3	/JMS SYMPPP
	JMP SYMPR4	/JMP SYMPR9-1
	TAD [-4		/JMP SYMPR6+2
	DCA SYMPR3	/HSWIT1
SYMPR6,	JMS SYMPPP	/204		//EOT
	JMP SYMPR9
	TAD [1777
	AND TAG1			/OUTPUT TAG
	JMS I (DIV45
	CLL CLA CMA RAR	/AC=3777
	AND TAG2
	JMS I (DIV45
	CLL CLA CMA RAR	/AC=3777
	AND TAG3
	JMS I (DIV45
	TAD [240
	JMS I OERROR			/OUTPUT SPACE
	TAD VALUE2
	JMS OCTPRT			/OUTPUT OCTAL VALUE
	ISZ SYMPR3	/JMP SYMPR5-2
	JMP SYMPR0	/TAD SYMPR6
SYMPR9,	TAD [215	/JMS I OERROR	/CARRIAGE RETURN
	JMS I OERROR	/TAD [377	//RUBOUT
	ISZ SYMPR7	/JMS I OERROR
	JMP .+5		/JMS SYMPR9+6
HSWIT2,	JMS I [FORMFD	/DCA LINCNT	/0 IF NOT /H
	TAD [-67	/JMP I SYMPRT	//--RETURN--
	DCA SYMPR7	/0
	TAD SYM245	/TAD [-200
	IAC		/DCA SYMPR2
	TAD SYMPR2	/TAD [200	//LEADER-TRAILER
	JMP SYMPR8	/JMS I OERROR

SYMPR4,	JMS SYMPPP	/ISZ SYMPR2
	JMP I SYMPRT	/JMP SYMPR4-2	/--RETURN--
	JMP SYMPR5	/JMP I SYMPR9+6



SYMPR0,	TAD (-66
	DCA SYMPPB
	JMS SYMPPP
	JMP SYMPR9
	ISZ SYMPPB
	JMP .-3
	JMS I [ERROR1
	JMS I [ERROR1
	JMS I [ERROR1
	JMP SYMPR6

SYMPR2=LINKSW
SYMPR3=UNDFSW
SYMPR7=ALPHAI
SYMPPB=CHKSUM

HEDCL2,
OCTPR1,
SYMPPP,	0
	ISZ THISTG
SYM245,	245
	TAD THISTG
	CLL CIA
	TAD HIGHTG
	SNL CLA
	JMP I SYMPPP	/--RETURN--
	JMS I [FINDTG
	CLL CLA CML RAR	/AC=4000
	AND TAG1
	TAD TAG3
	SPA SZL CLA
	JMP SYMPPP+1
	ISZ SYMPPP
	JMP I SYMPPP	/--RETURN--


/OCTAL PRINT ROUTINE
/ENTER WITH # TO BE OUTPUT IN AC

OCTPRT,	0
	DCA OCTPR1
	TAD [-4
	DCA OCTPR3
OCTPR2,	TAD OCTPR1	/GET EACH DIGIT SEPARATELY
	CLL RTL
	RAL
	DCA OCTPR1
	TAD OCTPR1
	RAL
	AND [7
	TAD ["0		/MAKE IT INTO AN ASCII CHARACTER
	JMS I OERROR	/OUTPUT IT
	ISZ OCTPR3
	JMP OCTPR2
	JMP I OCTPRT	/--RETURN--

HEDCL1,

/OUTPUT ONE REGISTER

PUNONE,	0
	TAD PASS	/WHICH PASS IS THIS?
	SNA
	JMP PUNON2	/PASS 2--OUTPUT BINARY
	SPA CLA
	JMP PUNON1+2	/PASS 1--EXIT
	JMS I (PUNFLD	/PRINT 5 DIGIT ADDRESS
DTORG1,	JMS I [ERROR1	/OUTPUT 2 SPACES
	TAD VALUE
	JMS OCTPRT	/OUTPUT CONTENTS
	TAD I [LINBUF	/IS THERE SOURCE CODE TO DUMP?
	SNA CLA
	JMP PUNON1	/NO-OUTPUT CARRIAGE RETURN
	TAD LINKSW	/YES-DUMP LINK SWITCH (' ) OR (  )
	JMS I [ERROR1
	JMS I (LINPRT	/DUMP SOURCE CODE
	JMP PUNON1+2	/AND EXIT

PUNON1,	TAD [215	/OUTPUT CARRIAGE RETURN
	JMS I OERROR
	DCA LINKSW	/CLEAR LINK SWITCH
	JMP I PUNONE	/--RETURN--

/PASS 2-OUTPUT ONE REGISTER
PUNON2,	TAD VALUE	/GET CONTENTS
	CLL
	JMS I [PUNOUT	/OUTPUT AS 2 FRAMES
	JMP PUNON1+2	/AND EXIT


OCTPR3,

/CLEAR PAGE HEADING BUFFER

HEDCLR,	0
	TAD [-40	/SET HEADING BUFFER
	DCA HEDCL2	/TO TABS
	TAD [HEADER-1
	DCA HEDCL1
	TAD [211
	ISZ HEDCL1
	DCA I HEDCL1
	ISZ HEDCL2
	JMP .-4
	JMP I HEDCLR	/--RETURN--

	PAGE

/**CURRENT PAGE LITERALS ON THIS PAGE WILL BE LOST**
/***WHEN OVERLAYED BY PUSHDOWN LIST**

/ARRANGE TO OUTPUT ONE REGISTER

PUNBIN,	0
	DCA VALUE
	JMS I [FINDSP	/FIND CURRENT PAGE NUMBER
	TAD [LITBUF
	DCA TEMP2	/POINT TO NUMBER OR LITERALS
	TAD LOC
	AND [177
	DCA TEMP
	TAD I TEMP2	/IS PAGE FULL?
	CIA
	TAD TEMP
	ISZ TEMP
	SPA CLA
	JMP ONEOK	/NO-OK TO ADD ONE MORE REGISTER
	TAD TEMP	/YES-
	DCA I TEMP2
	JMS I [FINDSP	/FIND CURRENT PAGE NUMBER
	SZA CLA		/IS THIS PAGE 0?
	JMP .+4
	JMS I PERROR	/YES-GENERATE ZE ERROR MESSAGE
	ZE
	JMP ONEOK	/PUT OUT CODE
	JMS I PERROR	/NO-GENERATE PE ERROR MESSAGE
	PE
ONEOK,	JMS I [FINDSP	/FIND CURRENT PAGE NUMBER
	TAD [TPINST
	DCA TEMP2
	TAD TEMP	/IS THIS ADDRESS HIGHER THAN PREVIOUS
	CIA		/HIGH INSTRUCTION PAGE?
	TAD I TEMP2
	SMA CLA
	JMP .+3		/NO
	TAD TEMP	/YES-THIS IS NEW HIGH INSTRUCTION
	DCA I TEMP2



PUNMOD,	JMS I [PUNONE	/OUTPUT THIS REGISTER
	ISZ LOC		/GET NEXT LOCATION
	TAD LOC		/IF THE "ISZ" SKIPS IT IS O.K. (A 0)
	AND [177	/IS THIS FIRST INSTRUCTION ON NEXT PAGE?
	SZA CLA
	JMP I PUNBIN	/NO--RETURN--
	JMS I [FINDSP	/YES-FIND CURRENT PAGE NUMBER
	TAD [LITBUF	/RESET POINTERS
	DCA TEMP2
	TAD I TEMP2
	DCA LITPTR
	JMP I PUNBIN	/--RETURN--


HEADER=.

/**********************************************************


/SECOND CONTINUATION OF EXPUNGE HANDLER
/CONTINUED FROM EXPUNW
/ENTER WITH TAG3 IN AC--PASS 1 ONLY

EXPUA1,	EXPUN2		/TEMPORARY STORAGE REGISTER
EXPUA2,	EXPUNY		/FIRST CONTINUATION

EXPUNV,	SPA CLA		/IS SYMBOL A PSEUDO-OP?
	JMP EXPUNZ	/YES
EXPUA4,	CLL CLA CML RTR	/AC=2000
	AND TAG1	/NO-IS IT I OR Z ?
	SNA CLA
	JMP .+5		/NO-FORGET TAG
EXPUNZ,	TAD I EXPUA1	/YES-RETURN TAG TO SYMBOL TABLE
	DCA THISTG
	JMS I [PUTTAG
	ISZ I EXPUA1
	ISZ TEMP1
	ISZ TEMP3	/DONE YET?
	JMP I EXPUA2	/NO- TRY NEXT TAG
	CLA CMA		/YES
	TAD I EXPUA1	/RESET HIGH TAG
	DCA HIGHTG
	JMP I [LOOKEX	/--EXIT TO MAIN--
/**********************************************************


/ASSEMBLER HEADER BUFFER

*HEADER+40

	" ;" ;"P;"A;"L;"C;"-
	"V;VERSION+"0
	" ;" 
DATE,	" ;" ;" ;" ;" ;" ;" ;" 
	" ;" ;"P;"A;"G;"E;" ;0



/PUSHDOWN LIST
/OCCUPIES NEXT 43(8) LOCATIONS
PDLND=.

PAGE

LINBUF=.+14		/LINE BUFFER OCCUPIES 122(8) LOCATIONS

PDLST=LINBUF-1

LITBUF=LINBUF+122	/LITERAL TABLE IS 40(8) LOCATIONS (ONE PER PAGE)
			/  SHOWING LOWEST PAGE ADDRESS USED FOR LITERALS

TPINST=LITBUF+40	/TOP INSTRUCTION TABLE IS 40(8) LOCTIONS
			/  SHOWING HIGHEST PAGE ADDRESS USED FOR INSTRUCTIONS

LITBF2=TPINST+40-17	/LITERAL BUFFER 2 CONTAINS UP TO 160(8)
			/PAGE 0 LITERALS

LITBF1=LITBF2+200-17	/LITERAL BUFFER 1 CONTAINS UP TO 100(8)
			/CURRENT PAGE LITERALS

/2217-2277 WILL CONTAIN MAIN ASSEMBLER CODE
/AFTER STARTUP PROCEDURES

IFNZRO LITBF1&177 < THIS IS AN ERROR!! >



	*1600

BEGIN,	CDF 10		/GET PARMS FROM MONITOR
	TAD I (MPARAM
	DCA PARM1
	TAD I (MPARAM+1
	DCA PARM2
	CDF
	TAD PARM2
	AND (20		/T?
	SNA CLA
	JMP BEGSKP+1	/LISTING NOT GOING TO TTY
	DCA I (HSWITC	/LISTING GOING TO TTY
BEGSKP,	SKP CLA
	DCA I (BEGIAB
	TAD PARM2
	AND (40		/S?
	SZA CLA
	DCA I (SSWITC	/LOOK UP COMMENT IN PAL8
	CLA CLL CML RTR	/N?
	AND PARM2
	SNA CLA
	JMP BEGN
	TAD BEGSKP
	DCA I (NSWITC	/DONT PRINT SYMBOL TABLE
	JMP BEGFH
BEGN,	TAD PARM1
	AND (20		/H?
	SNA CLA
	JMP BEGINB
BEGFH,	TAD I (FORM21
	DCA I (HSWITC
	DCA I (HSWIT1
	CLA SKP
BEGINB,	DCA I (HSWIT2
	TAD PARM1
	AND (400	/D?
	SNA CLA
	JMP BEGIN1
	TAD I XREG1
	DCA I LAST3	/COPY DDT COMPATIBLE SYMBOL TABLE CODE
	ISZ DSWIT3
	JMP .-3
	TAD I XREG2
	DCA I LAST4
	ISZ DSWIT4
	JMP .-3
BEGIN1,	CDF 10
	TAD I LAST2	/MOVE DATE INTO PASS3 BUFFER
	CDF 0
	DCA I LAST1
	ISZ DATCNT
	JMP BEGIN1
	DCA LAST1	/SIGNIFIES DATE IN BUFFER
	TAD (-10
	DCA LEADER
	DCA I (LINBUF+120
	DCA I (LINBUF+121
	JMP I (BEGIN2

DATCNT,	-10
PARM1,	0
PARM2,	0
DSWIT3,	DSWIT1-DSWITA-1
DSWIT4,	DSWIT2-DSWITB-1

	PAGE



BEGIN2,	TAD PARM1
	RTR		/K?
	SNL CLA
	JMP FLD1+3
	CDF 50
	JMS FLD2	/WHAT IS HIGHEST FIELD?
	JMP FLD1-1	/5
	CDF 40
	JMS FLD2
	JMP FLD1	/4
	CDF 30
	JMS FLD2
	JMP FLD1+1	/3
	CDF 20
	JMS FLD2
	JMP FLD1+2	/2
	JMP FLD1+3	/1
	TAD (1400	/IF FIELD 5, ALLOW 3840 SYMBOLS
FLD1,	TAD (1400	/OTHERWISE ALLOW 1400(NR OF FIELDS)
	TAD (1400
	TAD (1400
	TAD (1400
	DCA I (TAGMAX	/SET HIGHEST ADDRESS FOR TAGS
	TAD I (TAGMAX
	CLL RAL
	SZL SPA CLA	/IS FIELD 1 HIGHEST FIELD?
	JMP I (BEGING	/NO
OPTIM4,	TAD I OPTIM1	/YES - OPTIMIZE SEARCH PATTERN
	ISZ OPTIM1	/BY SUBSTITUTING CODE IN SEARCH
	DCA I OPTIM2	/ROUTINE
	ISZ OPTIM2
	ISZ OPTIM3
	JMP OPTIM4
OPTIM8,	TAD I OPTIM5
	ISZ OPTIM5
	DCA I OPTIM6
	ISZ OPTIM6
	ISZ OPTIM7
	JMP OPTIM8
	JMP I (BEGING

/SKIP IF CURRENT DATA FIELD DOES NOT EXIST
FLD2,	0
	TAD (FLD3
	DCA I (FLD4
FLD3,	CLA
	TAD I (FLD4
	NOP
	CDF
	TAD (-FLD3
	SZA CLA
	JMP FLD5
	TAD IOMON
	TAD [-200
	SNA CLA		/IS FIELD THERE?
	JMP I FLD2	/YES--RETURN--
	TAD [200
	DCA IOMON
FLD5,	ISZ FLD2	/NO-INCREMENT RETURN ADDRESS
	JMP I FLD2	/--RETURN--

FLD4,	IOMON



/OVERLAY CODE FOR OPTIMAL SYMBOL TABLE SEARCH
/IN 8K

OPTIM1,	OPTIMA
OPTIM2,	SETFLD+1
OPTIM3,	-7

OPTIM5,	OPTIMB
OPTIM6,	GETTG5
OPTIM7,	-21

OPTIMA,	CLL CMA RTL
	SETFLD+6&177+1200
	DCA TAGXR
	CDF 10
	SETFLD&177+5600
	-2002
	4

OPTIMB,	TAD HIGHTG
	SETFLD&177+4200
	TAD TAGXR
	DCA XREG1
	TAD XREG1
	SETFLD+7&177+1200
	DCA XREG2
	TAD THISTG
	SETFLD&177+4200
	TAD I XREG2
	DCA I XREG1
	TAD XREG1
	CIA
	TAD TAGXR
	SZA CLA
	GETTG5+11&177+5200
	CDF


/ONCE ONLY CODE FOR /D OPTION
/PUT INTO SYMLST FOR DDT COMPATIBLE SYMBOL TABLE

DSWIT1,	SYMPR6-1&177+3600
	SYMPR9+6&177+4200
	TAD [377
	JMS I OERROR
	CLA CMA
	DCA THISTG
	TAD [215
	JMS I OERROR
	SYMPPP&177+4200
	SYMPR9-1&177+5200
	SYMPR6+2&177+5200
	HSWIT1
DSWITA,	204



/OVERLAY CODE FOR DDT SYMBOL TABLE PRINT

DSWIT2,	SYMPR5-2&177+5200
	SYMPR6&177+1200
	JMS I OERROR
	TAD [377
	JMS I OERROR
	SYMPR9+6&177+4200
	DCA LINCNT
	SYMPRT&177+5600
	0
	TAD [-200
	DCA SYMPR2
	TAD [200
	JMS I OERROR
	ISZ SYMPR2
	SYMPR4-2&177+5200
DSWITB,	SYMPR9+6&177+5600



/**********************************************************

	*LITBF1+17

/SET FIELD DIGIT

FIELDA,	0
	AND [7		/STORE FIELD NUMBER
	DCA VALUE
	TAD VALUE	/MAKE FIELD NUMBER INTO ASCII DIGIT
	TAD ["0
	DCA FLDIND
	JMP I FIELDA	/--RETURN--


/PRINT 5 DIGIT ADDRESS

PUNFLD,	0
	TAD FLDIND	/PRINT FIELD DIGIT
	JMS I OERROR
	TAD LOC		/PRINT 4 DIGIT ADDRESS
	JMS I PUNFL1
	JMP I PUNFLD	/--RETURN--

PUNFL1,	OCTPRT


/POP ENTRY OFF PUSHDOWN LIST
/AND JUMP TO THAT ADDRESS

POPJ,	TAD I PDLXR
	DCA TEMP
	JMP I TEMP

/FROM HERE TO 2277 IS OPEN FOR CHANGES
/TO MAIN ASSEMBLER CODE

	*2400

/HANDLER FOR TEXT PSEUDO-OP
/SPACES ARE IGNORED TO DELIMITER
/DELIMITER IS FIRST PRINTING CHARACTER
/OTHER THAN SPACE
/NON-PRINTING CHARACTERS ARE ILLEGAL
/A PRINTING CHARACTER HAS EITHER BIT 5
/OR BIT 6 SET, BUT NOT BOTH

TEXTX,	CLL CLA CML RAR	/AC=4000
	DCA GETCI	/; AND / ARE NOT END OF LINE
	JMS TEXT1A	/CHECK FOR PRINTING CHARACTER
	JMP TEXT8	/NON PRINTING - IGNORE
	TAD [-240	/IGNORE SPACES UNTIL DELIMITER
	SNA		/HAS BEEN FOUND
	JMP TEXT8
	TAD [240	/RESTORE CHARACTER
	CIA
	DCA VALUE2	/STORE NEGATIVE DELIMITER
	DCA TEXT6	/SET PACKING SWITCH
TEXT3,	JMS I [GETC	/GET NEXT CHARACTER
	JMS TEXT1A	/IS IT A PRINTING CHARACTER?
	JMP TEXT9	/NO - IC
	TAD VALUE2	/YES - IS IT DELIMITER?
	SNA CLA
	JMP TEXT4	/YES - TERMINATE
	TAD CHAR	/NO - PACK AND OUTPUT
	JMS TEXT2	/PACK IT
	JMP TEXT3

TEXT4,	DCA GETCI	/RESET GETC SWITCH
	JMS I [GETC	/SKIP DELIMITER
	CLA
	JMS TEXT2	/OUTPUT 0 TO FILE
	JMS TEXT2
/CHANGE LAST LOCATION TO:
/	NOP
/FOR NO EXTRA WORD OF ZEROS
	DCA GETCI	/RESET GETCI TO CALL ; AND / END OF LINE
	JMP I [LOOKEX	/--EXIT TO MAIN--

TEXT8,	JMS I [GETC	/GET NEXT CHARACTER
	JMP TEXTX+2


TEXT9,	JMS I [ERROR	/GENERATE IC ERROR MESSAGE
	IC
	JMP TEXT3

/SKIP ON NON-PRINTING CHARACTER
TEXT1,	0
	AND (140	/IS BITS 5 OR 6 SET?
	SNA
	JMP .+3		/NO
	TAD (-140	/YES - ARE BIT 5 AND 6 SET?
	SNA CLA
	ISZ TEXT1	/YES - NON-PRINTING CHARACTER
	JMP I TEXT1	/--RETURN--

/SKIP ON PRINTING CHARACTER
TEXT1A,	0
	TAD CHAR
	SPA SNA		/IS CHARACTER -
	JMP TEXT4+2	/YES
	JMS TEXT1	/NO - IS IT PRINTING?
	ISZ TEXT1A	/YES - INCREMENT RETURN
	TAD CHAR	/WITH CHARACTER IN AC
	JMP I TEXT1A	/--RETURN--

/OUTPUT 2 TEXT CHARACTERS (ONE REGISTER)
/ENTER WITH CHARACTERS IN AC
TEXT2,	0
	AND [77		/GET RIGHT 6 BITS
	ISZ TEXT6	/WHICH HALF OF WORD?
	JMP TEXT5	/LEFT
	TAD TEXT7	/RIGHT--ADD IN LEFT HALF
	JMS I [PUNBIN	/OUTPUT IT
	JMP I TEXT2	/--RETURN--

TEXT5,	JMS I [RTL6	/GET LEFT HALF OF WORD
	DCA TEXT7	/SAVE IT
	CLA CMA		/SET SWITCH FOR RIGHT HALF
	DCA TEXT6
	JMP I TEXT2	/--RETURN--

TEXT6,	0
TEXT7,	0

/HANDLER FOR EXPUNGE PSEUDO-OP

EXPUNX,	TAD PASS	/IS THIS PASS 1
	SMA CLA
	JMP I [LOOKEX	/NO--EXIT TO MAIN--
	JMP I (EXPUNW	/YES-CONTINUE AT EXPUNW


/ADD BITS TO PUNCH ORIGIN

PUNORG,	0
	DCA LOC
	TAD PASS	/IS THIS PASS 2?
	SZA CLA
	JMP I PUNORG	/NO--RETURN--
	TAD LOC		/YES - OUTPUT ORIGIN SETTING
	CLL CML
	JMS I [PUNOUT
	JMP I PUNORG	/--RETURN--


MOUNT,	0
	CLA CLL		/JUST IN CASE WE GET BY AN ERROR CALL
	JMS WRTMSG
	MOUNTM
	TAD IPTR
	IAC
	DCA SPTR	/GET CURRENT FILE POINTER
	TAD (-6
	DCA KNT
	JMS OUTEM	/TYPE OUT THE FILENAME
	TAD (".&177
	JMS TOUT
	CLA CLL CMA RTL
	DCA KNT		/EXTENSION KNT
	JMS OUTEM
ASKAGN,	TAD ("?&177+400	/A MUST PRINT CHAR
	JMS TOUT
	JMS KIN
	TAD [200	/CONVERT TO ASSEM NOTATION
	DCA CHAR
	TAD CHAR
	JMS TOUT
	TAD (CHAR
	JMS CNAME
	-1;BCLOSW
	SKP
	JMP ASKAGN
	JMS TSTNUM	/ASSEMBLERS CHECK DIGIT ROUTIE
	SKP
	JMP ASKAGN	/WASN'T A DIGIT
	CLA CLL CML RAR
	AND I IPTR	/TURN OFF MOUNT BIT BUT LEAVE BACK SPACE ALONE
	TAD CHAR
	DCA I IPTR
	JMS WRTMSG
	CRLFR
	JMP I MOUNT

	PAGE


/MAINLINE CODE

LOOKE2,	0		/WAS THIS END OF LINE
	TAD CHAR	/ OR END OF CONDITIONAL?
	TAD [-">
	SNA
	JMP CONEND	/END OF CONDITIONAL
	TAD (">
	SMA CLA
	JMP I LOOKE2	/NOT END OF LINE--RETURN--
LOOKE1,	JMS I [GETC	/GET A CHARACTER
MAIN,
MAIN1,	JMS I [SPNOR	/IGNORE SPACES
	TAD CHAR
	TAD (-"$	/WAS IT $ ?
	SNA		/YES--
	JMP I (ENDPAS	/NO-END THIS PASS
	TAD ("$-"*
	SNA CLA		/WAS IT * ?
	JMP STAR	/YES-HANDLE *
	JMS I [TSTALP	/NO-WAS IT ALPHABETIC?
	JMP ALPHA	/YES
	JMS LOOKE2	/NO
TOEXP,	JMS I [EXP	/GET REST OF EXPRESSION
	TAD LININD
	DCA LINKSW	/STORE LINK SWITCH
	TAD VALUE
	JMS I [PUNBIN	/OUTPUT THE REGISTER
LOOKEX,	JMS I [SPNOR	/IGNORE TRAILING SPACES
	JMS LOOKE2	/IS LINE ENDED?
ILCHAR,	JMS I [ERROR	/NO-GENERATE IC ERROR MESSAGE
	IC
	JMP CONEN1

CONEND,	TAD CONDSW	/ARE WE INTO CONDITIONALS?
	SNA
	JMP ILCHAR	/NO - > IS ILLEGAL
	IAC		/ONE LESS CONDITIONAL
	DCA CONDSW
CONEN1,	JMS I [GETC	/GET NEXT CHARACTER
	JMP LOOKEX	/AND TRY FOR END AGAIN


/HANDLER FOR *

STAR,	JMS I [GETC	/GET NEXT CHARACTER AFTER *
	JMS I [SPNOR	/IGNORE SPACES
	JMS I [EXP	/GET REST OF EXPRESSION
	ISZ UNDFSW	/WAS ANYTHING UNDEFINED?
	JMP .+3		
	JMS I [ERROR	/YES-GENERATE UO ERROR MESSAGE
	UO
	TAD VALUE	/NO
	DCA OP
	TAD LOC		/IS THIS THE SAME PAGE AS
	AND [7600	/THE PREVIOUS CODE?
	CIA
	TAD OP
	AND [7600
	SNA CLA
	JMP I (STAR2	/YES-PUNCH ORIGIN
	JMS I [DUMPS	/NO-DUMP LITERALS
	TAD OP
	JMP I (STAR1-2	/PUNCH NEW ORIGIN

ALPHA,	JMS I [GETTAG	/PICK UP TAG-IS IT IN TABLE?
	CLA CMA		/NO
	DCA ALPHAI	/YES-FIX UNDEFINED TAG SWITCH
	TAD TAG3	/IS IT A PSEUDO-OP?
	SPA CLA
	JMP I VALUE2	/YES-GO TO ITS HANDLER
	TAD CHAR	/NO
	TAD (-",	/WAS IT TERMINATED BY , ?
	SNA
	JMP COMMA	/YES-DEFINE THE SYMBOL
	TAD (",-"=	/NO-WAS IT TERMINATED BY = ?
	SNA CLA
	JMP I (EQUAL	/YES-EQUATE THE SYMBOL
	CLL CLA CML RAR	/NO--AC=4000
	JMP TOEXP	/TREAT AS AN EXPRESSION

/HANDLER FOR "

QUOTE,	ISZ TXTPTR
	TAD I TXTPTR	/GET CHARACTER FROM TEXT BUFFER
	TAD [-215	/WAS IT CARRIAGE RETURN?
	SNA CLA
	JMP I (QUOTE1	/YES-IT IS IC-IGNORE "
	TAD I TXTPTR	/NO-PUT ASCII CODE INTO
	DCA VALUE2	/VALUE WORD
	JMS I [GETC	/GET NEXT CHARACTER
	JMP I (NUMBE1+1	/RETURN TO EXPRESSION PROCESSOR


/HANDLER FOR ,

COMMA,	JMS I [GETC	/GET NEXT CHARACTER
	ISZ ALPHAI	/WAS TAG DEFINED PREVIOUSLY?
	JMP COMMA2	/YES
	TAD LOC		/NO-STORE CURRENT ADDRESS FOR DEFINITION
	DCA VALUE2
	JMS I [INSRTG	/PUT TAG IN SYMBOL TABLE
COMMA1,	TAD TAG1	/STORE FOR ERROR MESSAGE OUTPUT
	DCA LAST1
	TAD TAG2
	DCA LAST2
	TAD TAG3
	DCA LAST3
	TAD VALUE2
	DCA LAST4
	JMP MAIN	/--EXIT TO MAIN--

COMMA2,	TAD LOC		/DO NEW AND OLD DEFINITIONS AGREE?
	CIA
	TAD VALUE2
	SNA CLA
	JMP COMMA1	/YES-ALLOW REDEFINITION
	JMS I [ERROR	/NO-GENERATE ID ERROR MESSAGE
	ID
	JMP MAIN	/--EXIT TO MAIN--


/HANDLER FOR ! AND SPACE AS INCLUSIVE OR

OP5,	TAD VALUE2
	AND VALUE
	CMA
	AND VALUE2
	JMP I (OP0+1

	PAGE


/EXPRESSION PROCESSOR
/POSSIBLE RECURSIVE ENTRY
/ENTER WITH CHARACTER IN CHAR

EXP,	0
	DCA EXPIND	/SET INDICATOR (NOT 0 IF NO MRI FOUND)
	DCA LININD	/CLEAR LINK GENERATED SWITCH (' )
	DCA VALUE	/START WITH "VALUE" = 0
	DCA UNDFSW	/CLEAR UNDIFINED SWITCH
	TAD EXP
	JMS I [PUSHA	/SAVE RETURN ADDRESS
	DCA OP		/OP=0; ADD
	TAD EXPIND
	SPA CLA
	JMP I (EXPINT
	TAD CHAR	/IS CHARACTER A + ?
	TAD [-"+
	SNA
	JMP EXP1-1	/YES-OP=0
	TAD ["+-"-	/NO-IS CHARACTER A - ?
	SZA CLA
	JMP EXP1+1	/NO
	ISZ OP		/YES-OP=1
	JMS I [GETC	/GET NEXT CHARACTER
EXP1,	ISZ EXPIND	/MRI NO LONGER LEGAL ON THIS LINE
	TAD CHAR	/IS CHARACTER A . ?
	TAD [-".
	SNA
	JMP PERIOD	/YES-GO TO . HANDLER
	TAD (".-""	/NO-IS IT " ?
	SNA
	JMP I (QUOTE	/YES-GO TO " HANDLER
	TAD (""-"[	/NO-IS IT [ ?
	SNA
	JMP I (LITZ	/YES-HANDLER PAGE 0 LITERAL
	TAD ("[-"(	/NO-IS IT ( ?
	SNA CLA
	JMP I (LITS	/YES-HANDLE SAME PAGE LITERAL


	JMS I [TSTALP	/NO-IS IT ALPHABETIC?
	JMP I (ALPHA1	/YES-HANDLE SYMBOL
	JMS I [TSTNUM	/NO-IS IT NUMERIC?
	JMP NUMBER	/YES-HANDLE NUMBER

EXP2,	JMS ENDCHK	/NO-CHECK FOR END
	JMP EXP1+1	/NOGO - TRY AGAIN
	TAD OP
	TAD [-5		/IS OP SPACE (5)
	SNA CLA
	JMP I (EXPXIT	/YES-EXIT
	DCA CHAR	/MAKE AN ILLEGAL CHARARACTER
	JMP EXP2


/END OF EXPRESSION CHECK
/SKIP IF OK

ENDCHK,	0
	TAD CHAR
	TAD (-"]	/IS CHARACTER A ] ?
	SZA		/YES-SKIP A EXIT
	TAD ("]-")	/IS CHARACTER A ) ?
	SZA		/YES-SKIP A EXIT
	TAD (")-">	/IS CHARACTER A > ?
	SZA		/YES-SKIP AND EXIT
	TAD (">-"<	/IS CHARACTER A < ?
	SNA
	JMP ENDCH1	/YES-SKIP AND EXIT
	TAD ("<
	SPA CLA		/IS IT END-OF-LINE?
	JMP ENDCH1	/YES-SKIP AND EXIT
	JMS I [ERROR	/NO-GENERATE IC ERROR MESSAGE
	IC
	JMS I [GETC	/GET NEXT CHARACTER & TRY AGAIN
	JMP I ENDCHK	/--RETURN--

ENDCH1,	ISZ ENDCHK	/INCREMENT RETURN ADDRESS
	JMP I ENDCHK	/--RETURN--


NUMBER,	DCA TEMP
NUMBE2,	TAD RADIX	/IS THE CURRENT RADIX OCTAL?
	SNA CLA
	TAD CHAR	/YES-IS THE DIGIT GREATER THAN 7?
	TAD (-"8
	SMA CLA
	JMP NUMBE3	/YES-ILLEGAL CHARACTER
	TAD TEMP	/NO-ADD IT TO THE PREVIOUS
	CLL RAL		/ACCUMULATED VALUE
	CLL RAL
	DCA TEMP2


	TAD RADIX	/IS RADIX OCTAL?
	SZA CLA
	TAD TEMP	/NO
	TAD TEMP2	/YES
	CLL RAL
	TAD CHAR
	TAD [-"0
	DCA TEMP
NUMBE4,	JMS I [GETC	/GET NEXT CHARACTER
	JMS I [TSTNUM	/IS IT NUMERIC?
	JMP NUMBE2	/YES-CONTINUE ACCUMULATING NUMBER
	TAD TEMP	/NO-STORE NUMBER
NUMBE1,	DCA VALUE2
	TAD OP		/GO COMBINE IT VIA LAST OPERATION
	TAD (OPTABL
	DCA TEMP	/FIND THE OPERATOR HANDLER
	TAD I TEMP
	DCA TEMP
	JMP I TEMP	/GO TO THE HANDLER
/8 OR 9 FOUND DURING OCTAL RADIX
NUMBE3,	JMS I [ERROR	/GENERATE IC ERROR MESSAGE
	IC
	JMP NUMBE4	/IGNORE CHARACTER

/HANDLER FOR .
PERIOD,	JMS I [GETC	/GET NEXT CHARACTER
	TAD LOC		/MAKE CURRENT LOCATION
	JMP NUMBE1	/INTO VALUE OF NUMBER

/CARRIAGE RETURN FOUND IN SINGLE CHARACTER TEXT

QUOTE1,	JMS I [ERROR	/GENERATE IC ERROR MESSAGE
	IC
	CLA CMA
	DCA CHAR
	JMP I (EXPXIT

	PAGE


ALPHA1,	JMS I [GETTAG	/PICK UP TAG-WAS IT IN TABLE?
	CLA CMA		/NO-SET UNDEFINED INDICATOR
	DCA ALPHAI	/YES-CLEAR UNDEFINED INDICATOR
	TAD TAG3	/IS IT A PSEUDO-OP?
	SMA CLA
	JMP .+3
	JMS I [ERROR	/YES-GENERATE IP ERROR MESSAGE
	IP
	ISZ ALPHAI	/NO-WAS IT UNDEFINED?
	JMP .+7
	ISZ UNDFSW	/YES-SET UNDEFINED SWITCH
	TAD PASS	/IS THIS PASS 1?
	SPA CLA
	JMP .+3		/YES-SUPPRESS ERROR MAESSAGE
	JMS I [ERROR	/NO-GENERATE US ERROR MESSAGE
	US
	TAD TAG2	/NO-WAS IT A MEMORY REFERENCE INSTRUCTION?
	SMA CLA
	JMP I (NUMBE1+1	/NO-GO COMBINE IT VIA LAST OPERATOR
	TAD CHAR	/YES-GET TERMINATING CHARACTER
	TAD [-240	/WAS IT SPACE?
	SZA CLA
	JMP I (NUMBE1+1 /NO
	JMS I [SPNOR	/YES-IGNORE SPACES
	TAD CHAR
	SPA CLA
	JMP I (NUMBE1+1
	TAD EXPIND	/IS MEMORY REFERENCE INSTRUCTION OK?
	SZA CLA
	JMP I (NUMBE1+1 /NO-
	DCA IZIND	/YES-CLEAR I AND Z INDICATOR
	TAD VALUE2	/STORE MRI ON PUSHDOWN LIST
	JMS I [PUSHA


ALPHA6,	JMS I [TSTALP	/WAS TERMINATING CHARACTER ALPHABETIC?
	SKP
	JMP ALPHA4	/NO-
	JMS I [GETTAG	/YES-PICK UP TAG-IS IT IN TABLE?
	CLA CMA		/NO-SET UNDEFINED INDICATOR
	DCA ALPHAI	/YES-CLEAR UNDEFINED INDICATOR
	CLL CLA CML RTR	/AC=2000
	AND TAG1	/WAS IT AN I OR Z?
	SNA CLA
	JMP ALPHA5	/NO
	TAD VALUE2	/YES-WAS IT I?
	SNA
	ISZ IZIND
	TAD IZIND
	DCA IZIND
	JMS I [SPNOR	/IGNORE SPACES
	JMP ALPHA6

EXPINT,	TAD EXPIND
	TAD [4000
	DCA EXPIND
	JMP ALPHA1+3

ALPHA5,	TAD IZIND	/SAVE I OR Z INDICATOR
	JMS I [PUSHA
	CLL CLA CML RAR	/AC=4000
	JMP ALPHA4+2

ALPHA4,	TAD IZIND	/SAVE I OR Z INDICATOR
	JMS I [PUSHA	/ON PUSHDOWN LIST
	IAC
	JMS I [EXP	/GET REST OF EXPRESSION
	TAD I PDLXR	/RETRIEVE MRI
	DCA IZIND
	TAD I PDLXR
	DCA VALUE2
	DCA LININD	/CLEAR LINK GENERATED SWITCH
	TAD IZIND	/WAS Z FOUND?
	AND [77
	SNA CLA
	JMP FIX1	/NO-COMBINE ADDRESS WITH INSTRUCTION
	TAD VALUE	/YES-IS THIS PAGE 0?
	AND [7600
	SNA CLA
	JMP FIX4	/YES-
	JMS I [ERROR	/NO-GENERATE IZ ERROR MESSAGE
	IZ


/COMBINE ADDRESS WITH MEMORY REFERENCE INSTRUCTION

FIX1,	TAD VALUE	/GET ADDRESS
	AND [7600
	SNA		/IS IT PAGE 0?
	JMP FIX4	/YES
	CIA		/NO-IS IT ON CURRENT PAGE?
	TAD LOC
	AND [7600
	SNA CLA
	JMP FIX2	/YES
	TAD VALUE	/NO-SET UP LINK
	JMS I (FINDS
	DCA VALUE
	TAD [0700	/SET INDICATOR TO PRINT '
	DCA LININD	/TO SHOW LINK GENERATED
	TAD [400
FIX2,	TAD [200	/SET CURRENT PAGE BIT
	TAD VALUE2
	DCA VALUE2
FIX4,	TAD IZIND	/WAS THERE AN I?
	AND [7700
	SNA CLA
	JMP FIX3	/NO
	TAD VALUE2	/YES-SET INDIRECT BIT
	AND [400
	SNA CLA		/WAS INDIRECT BIT ALREADY SET?
	JMP FIX5	/NO
	JMS I [ERROR	/YES-GENERATE II ERROR MESSAGE
	II
	JMP FIX3	/OUTPUT CODE AS IS

/SET INDIRECT BIT
FIX5,	TAD [400
	TAD VALUE2
	DCA VALUE2
/COMBINE ADDRESS WITH MRI
FIX3,	TAD VALUE	/GET ADDRESS
	AND [177
	TAD VALUE2	/GET OP CODE
	DCA VALUE	/STORE
	JMP I [POPJ	/--EXIT VIA POPJ--

/FETCH CHARACTER FROM TTY AND CHECK FOR ^O

OTYPEO,	0
	JMS I (OTYPE1	/TYPE CHARACTER IN AC
	JMP I OTYPEO	/NO--RETURN--

	PAGE


/COMBINE CURRENT VALUE WITH PREVIOUS VALUE
/ACCORDING TO LAST OPERATOR

OP0,	TAD VALUE2	/HANDLER FOR +
	TAD VALUE
	DCA VALUE
EXP3,	TAD CHAR	/GET LAST OPERATOR
	TAD [-"+	/WAS IT A + ?
	SNA
	JMP EXP4+5	/YES
	TAD ["+-"-	/NO-WAS IT A - ?
	SNA
	JMP EXP4+4	/YES
	TAD [7		/NO("--"& = 255-246 = 7)-WAS IT & ?
	SNA
	JMP EXP4+3	/YES-
	TAD ("&-"!	/NO-WAS IT ! ?
	SNA
	JMP EXP4+2	/YES
	TAD ("!-"^	/NO-WAS IT ^ ?
	SNA
	JMP EXP4+1	/YES
	TAD ("^-240	/NO-WAS IT SPACE?
	SNA
	JMP EXP4	/YES
	TAD (240-"%	/NO-WAS IT % ?
	SNA CLA
	JMP EXP4-1	/YES
	JMS I (ENDCHK	/NO-SEE IF END OF LINE FOUND
	JMP EXP3	/NO-TRY AGAIN
EXPXIT,	TAD UNDFSW	/EXIT FROM EXP
	SNA CLA		/RESTORE EXIT POINT
	JMP I [POPJ	/--EXIT VIA POPJ--
	CLA CMA
	DCA UNDFSW	/SET UNDEFINED SWITCH
	DCA VALUE	/RESULT IS 0
	JMP I [POPJ	/--EXIT VIA POPJ--


	IAC
EXP4,	IAC
	IAC
	IAC
	IAC
	IAC
	DCA OP
	JMS I [GETC	/GET NEXT CHARACTER
	JMP I (EXP1	/GET REST OF EXPRESSION

/HANDLER FOR &

OP2,	TAD VALUE
	AND VALUE2
	JMP OP0+2


/HANDLER FOR ^
/MULTIPLY BY REPEATED ADDITION

OP4,	TAD VALUE
	CIA
	DCA TEMP
	TAD VALUE2
	ISZ TEMP
	JMP .-2
	JMP OP0+2


/CHARACTER INPUT CHECK
/ENTER WITH CHARACTER IN AC

LSTCH9,	TAD (-177
	SZA		/IGNORE RUBOUT (377)
	TAD (177-13
	SZA		/IGNORE VERTICAL TAB (213)
	IAC
	SNA
	JMP I (INPUT+1	/IGNORE LINE FEED (212)
	TAD [12-32	/WAS IT ^Z (END-OF-FILE=232)?
	SNA
	JMP I (GETFLE	/YES - GET NEXT FILE
	TAD (32-15	/NO - WAS IT CARRIAGE RETURN?
	SNA
	JMP LSTCHR	/YES - LAST CHARACTER OF LINE
	IAC		/NO
	SNA		/WAS IT FORM FEED (214)?
	JMP FORCHR	/YES - HANDLER FORM FEED
	ISZ I (INPUT
LSTCH2,	TAD (14+200
	DCA LSTCH5	/STORE CHARACTER
	TAD PASS	/IS THIS PASS 3?
	SPA SNA CLA
	JMP LSTCH4	/NO -
	ISZ LSTCH6	/YES - FILLING HEADER AREA?
	JMP LSTCH3	/YES
	CLA CMA		/NO - RESET SWITCH
	DCA LSTCH6
LSTCH4,	TAD I (INPUT
	DCA TEMP
	TAD LSTCH5	/GET CHARACTER IN AC
	JMP I TEMP	/-EXIT FROM INPUT-

LSTCH3,	ISZ LSTCH7	/FILLING HEADER
	TAD LSTCH5	/STORE CHARACTER IN HEADER AREA
	DCA I LSTCH7
	JMP LSTCH4

LSTCH5,	0
LSTCH6,	-40
LSTCH7,	HEADER-1



LSTCHR,	TAD FORMSW	/CARRIAGE RETURN WAS FOUND
	SNA CLA		/HAS THERE BEEN A FORM FEED?
	JMP LSTCH1	/NO -
	DCA FORMSW	/YES - CLEAR FORM FEED SWITCH
	ISZ EDITPG	/GO TO NEXT EDITOR PAGE
	DCA THISPG	/CLEAR OVERFLOW PAGE
	TAD PASS	/IS THIS PASS 3?
	SMA SZA CLA
	JMS I [FORMFD	/YES - GENERATE FORM FEED
LSTCH1,	TAD [215	/NO - CARRIAGE RETURN IS CHARACTER
	DCA LSTCH5
	JMP LSTCH4-2	/EXIT

FORCHR,	ISZ FORMSW	/SET FORM FEED SWITCH
	JMP I (INPUT+1	/GET ANOTHER CHARACTER

FORMSW,	1

PUSHA1,	TAD (BE		/GENERATE BE ERROR MESSAGE
	JMP I [MONERR	/**FATAL ERROR**

/TABLE OF OPERATOR HANDLING ROUTINES

OPTABL,	OP0		/+
	OP1		/-
	OP2		/&
	OP5		/!
	OP4		/^
	OP5		/(SPACE)
	OP6		/%

	PAGE


/ERROR MESSAGE OUTPUT
ERROR,	0
	CLA
	TAD I ERROR	/GET ERROR MESSAGE
	ISZ ERROR	/INCREMENT RETURN ADDRESS
	JMS ERROR1	/OUTPUT 2 CHARACTER ERROR MESSAGE
	TAD PASS	/IS THIS PASS 3?
	SMA SZA CLA
	JMP ERROR4	/YES - CARRIAGE RETURN/LINE FEED
	JMS ERROR1	/NO - OUTPUT 2 SPACES
	TAD [1777	/IS THERE A TAG SAVED?
	AND LAST1
	SNA
	JMP ERROR3	/NO
	JMS I (DIV45	/YES - OUTPUT FIRST 2 CHARACTERS
	CLL CLA CMA RAR	/AC=3777
	AND LAST2	/OUTPUT SECOND 2 CHARACTERS
	JMS I (DIV45
	CLL CLA CMA RAR	/AC=3777
	AND LAST3
	JMS I (DIV45	/OUTPUT THIRD 2 CHARACTERS
	TAD LAST4	/IS ERROR LOCATION SAME AS LAST TAG?
	CIA
ERROR3,	TAD LOC
	SNA
	JMP ERROR4	/YES - CARRIAGE RETURN
	DCA ERROR5	/NO - OUTPUT +
	TAD ("+
	JMS I OERROR
	TAD ERROR5	/OUTPUT 4 DIGIT ADDRESS OR INCREMENT
	JMS I (OCTPRT
ERROR4,	TAD [215	/OUTPUT CARRIAGE RETURN/LINE FEED
	JMS I OERROR
	JMP I ERROR	/--RETURN--

/OUTPUT 1 ERROR MESSAGE CHARACTER

ERROR2,	0
	AND [77
	TAD [240	/MAKE ASCII CHARACTER
	JMS I OERROR
	JMP I ERROR2	/--RETURN--

ERROR5,

/RESET LITERAL TABLES AND POINTERS

CLEAN,	0
	TAD (LITBUF-1
	DCA XREG1	/SET LITERAL TABLE POINTER
	TAD (TPINST-1
	DCA XREG2	/SET TOP INST. TABLE POINTER
	TAD [-40
	DCA TEMP
	TAD [200
	DCA I XREG1	/SET LITERAL TABLE ENTRIES TO 200
	DCA I XREG2	/SET TOP INST. TABLE ENTRIES TO 0
	ISZ TEMP
	JMP .-4
	DCA LAST1	/CLEAR LAST DEFINED TAG
	JMP I CLEAN	/--RETURN--


/DUMP CURRENT PAGE LITERALS

DUMPS,	0
	JMS I [FINDSP	/PAGE ZERO?
	SNA
	JMP I DUMPS	/YES --RETURN--
	TAD [LITBUF	/NO
	DCA DUMPS1
	TAD LITPTR
	CIA
	TAD I DUMPS1	/ARE THERE LITERALS ON THIS PAGE?
	SMA
	JMP DUMPS4	/NO - EXIT
	DCA DUMPS2	/YES
	TAD LOC
	AND [7600
	TAD I DUMPS1
	JMS I [PUNORG	/OUTPUT ORIGIN
	TAD I DUMPS1
	TAD [LITBF1
	DCA DUMPS1
DUMPS3,	TAD I [LINBUF	/SAVE LINBUF
	JMS I [PUSHA
	DCA I [LINBUF
	TAD I DUMPS1
	DCA VALUE
	JMS I [PUNONE	/OUTPUT ONE REGISTER
	ISZ LOC
	ISZ DUMPS1
	ISZ DUMPS2
	JMP DUMPS3+3
	TAD I PDLXR
	DCA I [LINBUF	/RESTORE LINBUF
DUMPS4,	CLA
	JMP I DUMPS	/--RETURN--


/DUMP PAGE 0 LITERALS

DUMPZ,	0
	TAD DUMPZ	/RESET EXIT FROM DUMPS
	DCA DUMPS
	TAD [200
	CIA
	TAD I [LITBUF	/ARE THERE LITERALS TO DUMP?
	SMA
	JMP DUMPS4	/NO-EXIT
	DCA DUMPS2	/YES-SET COUNTER
	TAD I [LITBUF	/SET VALUES FOR DUMPS
	TAD (LITBF2
	DCA DUMPS1
	TAD I [LITBUF
	JMS I [PUNORG	/OUTPUT ORIGIN
	JMP DUMPS3

DUMPS1=ERROR
DUMPS2=DUMPZ


/OUTPUT 2 CHARACTER ERROR CODE

ERROR1,	0
	DCA ERROR5
	TAD ERROR5
	JMS I [RTL6
	RAL
	JMS ERROR2	/OUTPUT FIRST CHARACTER
	TAD ERROR5
	JMS ERROR2	/OUTPUT SECOND CHARACTER
	JMP I ERROR1	/--RETURN--

	PAGE


/ENTER A TAG INTO SYMBOL TABLE

INSRTG,	0
	TAD VALUE2	/SAVE VALUE 2
	JMS I [PUSHA
	ISZ HIGHTG	/COUNT IN THIS TAG
	TAD TAGMAX
	CLL CIA		/GET LIMIT OF SYMBOL STORAGE
	TAD HIGHTG	/IS THERE ROOM FOR ONE MORE?
	SZL CLA
	JMP GETTG7	/NO - SE**FATAL ERROR**
GETTG5,	TAD THISTG	/SEARCH SYMBOL TABLE
	DCA TEMP2
	TAD HIGHTG
	IAC
	DCA THISTG
GETTG8,	CLL CLA CMA RAL	/AC=7776
	TAD THISTG
	DCA THISTG
	JMS I [FINDTG	/GET NEXT TAG FROM SYMBOL TABLE
	ISZ THISTG
	TAD THISTG
	CIA
	TAD TEMP2	/DOES NEW TAG GO WHERE PREVIOUS TAG WAS?
	SNA CLA
	JMP GETTG9	/YES-PUT IT THERE AND EXIT
	JMS I [PUTTAG	/NO-REPLACE RETRIEVED TAG WHERE PREVIOUS TAG WAS
	JMP GETTG8
/THE ABOVE CODE WILL BE OPTIMIZED AT INITIALIZATION
/IF THE ASSEMBLER IS TO BE RESTRICTED TO 8K OF CORE


GETTG9,	TAD I (NAME1	/GET CURRENT TAG
	DCA TAG1	/PUT IT IN TAG1-TAG3
	TAD I (NAME2
	DCA TAG2
	TAD I (NAME3
	DCA TAG3
	TAD I PDLXR	/RESTORE VALUE 2
	DCA VALUE2
	JMS I [PUTTAG	/PUT TAG1 - TAG3 INTO SYMBOL TABLE
	JMP I INSRTG	/--RETURN--

TAGMAX,	1400

/SYMBOL TABLE EXCEEDED

GETTG7,	TAD (SE		/GENERATE SE ERROR MESSAGE
	JMP I [MONERR	/**FATAL ERROR**

/OUTPUT 2 CHARACTER WORD
/FROM SYMBOL TABLE FORMAT
/DIVIDE BY 45(8)

DIV45,	0
	DCA DIV45B
	DCA DIV45C
	JMP DIV45D

DIV45A,	ISZ DIV45C
	DCA DIV45B
DIV45D,	TAD DIV45B
	TAD (-45
	SMA
	JMP DIV45A
	TAD (45
	JMS DIV45E
	DCA DIV45B
	TAD DIV45C
	JMS DIV45E
	JMS I [RTL6
	TAD DIV45B
	JMS I [ERROR1	/OUTPUT 2 CHARACTERS
	JMP I DIV45	/--RETURN--

DIV45B,	0

DIV45E,	0
	SNA
	JMP I DIV45E
	TAD (-33
	SMA
	TAD (20-40-33
	TAD (33+40
	JMP I DIV45E	/--RETURN--

/HANDLER FOR FIXTAB PSEUDO-OP

FIXTBX,	TAD PASS	/IS THIS PASS 1?
	SMA CLA
	JMP I [LOOKEX	/NO--EXIT TO MAIN--
	JMP I (FIXTAY	/YES--DO FIXTAB
DIV45C,



/SET FIELD

SETFLD,	0
	CLA		/SETFLD CALLED WITH AC RANDOM
	DCA SETFL1	/INITIALIZE FIELD
	TAD THISTG
SETFLP,	ISZ SETFL1
	CLL
	TAD (-1400	/PUT 1400 SYMBOLS IN EACH FIELD
	SZL		/IS THE DIVIDE THROUGH?
	JMP SETFLP	/NO - CONTINUE
	CLL CMA RTL	/AC CONTAINED REM-1400; THIS MAKES IT INTO
	TAD (-1		/7573-4*REM WHICH IS THE ADDRESS WE WANT
	DCA TAGXR	/TO STICK INTO AN AUTO-XR
	TAD SETFL1
	CLL RTL
	RAL
	TAD SETFL2
	DCA SETFL1
SETFL1,	HLT
	JMP I SETFLD	/--RETURN--

/FIND TAG
/GET TAG FROM SYMBOL TABLE
/PUT IT INTO TAG1-TAG3
/WITH ITS VALUE IN VALUE2

FINDTG,	0
	TAD THISTG
	JMS SETFLD
	TAD I TAGXR
	DCA TAG1
	TAD I TAGXR
	DCA TAG2
	TAD I TAGXR
	DCA TAG3
	TAD I TAGXR
	DCA VALUE2
SETFL2,	CDF
	JMP I FINDTG	/--RETURN--
/OPTIMIZATION MAY CHANGE SETFLD TO
/REMOVE CLA ON ENTRY


STAR2,	TAD OP
	JMS I [PUNORG	/PUNCH ORIGIN
	DCA LAST1	/CLEAR LAST DEFINED SYMBOL
	JMP I [PUNVAL

	PAGE


/BEGINNING OF PASS CODE

START2,	ISZ PASS	/SET UP COUNTERS AND POINTERS
	DCA XLISTX	/CLEAR XLIST SWITCH
	JMS I (IINIT	/SET INPUT ROUTINE TO OPEN FILE
	DCA GETCI
	DCA PUNCHX	/CLEAR PUNCH INHIBIT
	DCA I [LINBUF
	DCA RADIX	/SET RADIX TO OCTAL
	TAD (PDLST
	DCA PDLXR	/INITIALIZE PUSHDOWN LIST
	TAD ["0		/SET FIELD TO 0
	DCA FLDIND
	DCA CONDSW
	DCA EDITPG
	JMS I [CLEAN	/CLEAN UP LITERAL BUFFERS
	TAD [200
	DCA LITPTR
	TAD [200	/PUNCH ORIGIN 0200
	JMS I [PUNORG
	JMP I (LOOKE1	/--EXIT TO MAIN--

/HANDLER FOR $

ENDPAS,	JMS I [DUMPS	/DUMP CURRENT PAGE LITERALS
	TAD PASS	/WHAT PASS IS ENDING?
	SNA
	JMP ENDPA2	/PASS 2
	SPA CLA
	JMP I (START1	/PASS 1
	TAD I [LINBUF	/PASS 3
	SNA CLA		/ANYTHING TO PRINT?
	JMP ENDPA1-1	/NO
	TAD [211	/YES - TAB OVER TWICE
	JMS I OERROR
	TAD [211
	JMS I OERROR
	JMS I (LINPRT	/PRINT LINE
	JMS I [DUMPZ	/DUMP PAGE 0 LITERALS
ENDPA1,	DCA XLISTX
/OUTPUT SYMBOL TABLE
SSWITC,	JMS I (SYMPRT	/(0 IF /S)
	TAD I (FORM21
	DCA I (FORM22
	JMS I [FORMFD	/OUTPUT FORM FEED
MONWT,	TAD LPCHCT
	TAD TTCHCT
	SZA CLA
	JMP MONWT
	JMS WRTMSG
	UPC		/PRINT ^C AND WAIT FOR CHAR
	JMS KIN
	7600
	JMP I .-1	/BOOTSTRAP

/END PASS 2

ENDPA2,	JMS I [DUMPZ	/DUMP PAGE 0 LITERALS
	DCA PUNCHX
	JMS I (OCLOSE	/CLOSE PASS 2 OUTPUT FILE
	TAD (LISOUT
	DCA OERROR	/SET NEW OUTPUT TO BE LISTING
	ISZ I (OUTPT1
	TAD LSLOT
	SNA CLA
	JMP MONWT	/NO PASS 3
	DCA OUTINH
	TAD (P3O&177+5200	/JUMP TO LIST SUBROUTINE
	DCA OUTPUX+1	/STORE OVER BINARY OUTPUT SUBROUTINE
	TAD (-377	/ADDITIONAL RING BUFFER ROOM
	DCA CNT
	TAD (OBUFR
	DCA PTR
	DCA I PTR
	ISZ PTR
	ISZ CNT
	JMP .-3
	TAD LPCHCT	/BEFORE MANGLING LPT RING BUFFER
	SZA CLA		/ MAKE SURE ITS EMPTY
	JMP .-2
	TAD I (LPBUFR+LPSIZE
	DCA I PTR
	TAD (OBUFR
	DCA I (LPBUFR+LPSIZE
	TAD (377
	TAD LPSIZ
	DCA LPSIZ
	ISZ LSLOT
	JMP NSWITC	/REALLY WAS LINE PRINTER
	TAD (P3OT&177+4600	/JMS TO THE PRINT A TTY CHAR ROUTINE
	DCA P3OF	/MAKE THE LPOCHR JMS A TTOCHR JMS
	TAD TTCHCT
	SZA CLA
	JMP .-2
	TAD I (TTBUFR+TTSIZE
	DCA I PTR
	TAD (OBUFR
	DCA I (TTBUFR+TTSIZE
	TAD (377
	TAD TTSIZ
	DCA TTSIZ	/EXPAND TTY RING BUFFER IF LISTING TO IT
NSWITC,	JMP START2	/(SKP IF /N) START NEXT PAGES
	NOP
	JMP ENDPA1

	PAGE


/EVALUATE LITERAL

LITS,	CLA CMA		/CURRENT PAGE
LITZ,	DCA LITS1	/PAGE 0
	JMS I [GETC	/GET NEXT CHARACTER
	JMS I [SPNOR	/IGNORE SPACES
	TAD EXPIND	/STORE IMPORTANT VALUES PRIOR TO
	JMS I [PUSHA	/ENTRANCE INTO EXP
	TAD OP
	JMS I [PUSHA
	TAD VALUE
	JMS I [PUSHA
	TAD LITS1
	JMS I [PUSHA
	JMS I [EXP	/GET EXPRESSION
	TAD I PDLXR	/RETRIEVE PAGE INDICATOR
	DCA LITS1
	TAD VALUE	/FIND LITERAL IN TABLE
	ISZ LITS1	/PAGE 0?
	JMP .+3
	JMS FINDS	/NO
	SKP
	JMS FIND0	/YES
	DCA VALUE2	/STORE ADDRESS
	TAD LITS1
	CMA
	DCA LITS1
	TAD I PDLXR
	DCA VALUE
	TAD I PDLXR	/RESTORE SAVED VALUES
	DCA OP
	TAD I PDLXR
	DCA EXPIND
	TAD CHAR	/IGNORE ) OR ]
	TAD (-")
	ISZ LITS1
	TAD (")-"]
	SNA CLA
	JMS I [GETC	/GET NEXT CHARACTER
	JMP I (NUMBE1+1	/RETURN TO EXPRESSION PROCESSOR

LITS1,	0




/FIND LITERAL ON CURRENT PAGE

FINDS,	0
	DCA FINDS1
	TAD LOC
	AND [7600
	SNA		/IS THIS PAGE 0?
	JMP FIND01	/YES
	DCA FINDS2	/NO - SAVE PAGE NUMBER
	TAD [LITBF1
	DCA FIND0
	TAD [7700	/ALLOW 100(8) CURRENT PAGE LITERALS
	DCA FORMF6
	TAD LITPTR
FIND02,	DCA FINDS3
	TAD FINDS2
	JMS I [RTL6
	TAD [LITBUF
	DCA TEMP
	TAD FIND0
	TAD I TEMP
	DCA TEMP2
	TAD FINDS3
	CIA
	TAD I TEMP
	SNA
	JMP FINDS6
	DCA FINDS3
FINDS4,	TAD I TEMP2	/GET LITERAL FROM TABLE
	CIA
	TAD FINDS1	/AND CURRENT LITERAL
	SNA CLA		/DO THEY MATCH?
	JMP FINDS5	/YES
	ISZ TEMP2	/NO - BUMP COUNTERS
	ISZ FINDS3
	JMP FINDS4	/TRY AGAIN
FINDS6,	TAD FINDS2
	JMS I [RTL6
	TAD [TPINST
	DCA FINDS3
	TAD I TEMP	/DOES THIS OVERFLOW PAGE?
	CIA
	TAD I FINDS3
	SPA CLA
	JMP FINDS7	/NO




FIND03,	TAD FINDS2	/YES - PAGE 0?
	SNA CLA
	JMP .+4
	JMS I PERROR	/NO - GENERATE PE ERROR MESSAGE
	PE
	JMP FINDS8
	JMS I PERROR	/YES - GENERATE ZE ERROR MESSAGE
	ZE
FINDS8,	CLA CMA
	JMP FINDS9
FINDS7,	CLA CMA
	TAD I TEMP	/IS PAGE FULL?
	AND FORMF6
	SNA CLA
	JMP FIND03	/YES - OUTPUT ERROR MESSAGE
	CLA CMA
	TAD I TEMP	/NO
	DCA I TEMP
FINDS9,	TAD I TEMP
	TAD FIND0
	DCA TEMP2
	TAD FINDS1
	DCA I TEMP2
FINDS5,	TAD FIND0	/GET ADDRESS OF LITERAL
	CIA
	TAD TEMP2
	TAD FINDS2
	JMP I FINDS	/--RETURN--


/FIND LITERAL ON PAGE 0

FIND0,	0
	DCA FINDS1
	TAD FIND0	/RESET EXIT FROM FINDS
	DCA FINDS
FIND01,	DCA FINDS2	/SET POINTERS
	TAD (LITBF2
	DCA FIND0
	TAD [7760	/ALLOW 160(8) PAGE 0 LITERALS
	DCA FORMF6
	TAD [200
	JMP FIND02

FINDS1,	0
FINDS2,	0
FINDS3,	0

	PAGE


/HANDLER FOR IFZERO PSEUDO-OP

IF0,	TAD [10		/IFTST1, SNA CLA

/HANDLER FOR IFNZERO PSEUDO-OP

IFN0,	TAD IFSZA	/IFTST1, SZA CLA
	DCA IFTST1
	JMS I [SPNOR	/IGNORE SPACES
	JMS I [EXP	/GET EXPRESSION
IFTST3,	TAD CHAR	/GET LAST CHARACTER
	TAD (-"<
	SNA CLA		/IS IT <?
	JMP IFTST2	/YES
	JMS I [ERROR	/NO - GENERATE IC ERROR MESSAGE
	IC
	JMS I [GETC	/GET NEXT CHARACTER
IFTST9,	JMS I [SPNOR	/IGNORE SPACES
	JMP IFTST3	/TRY AGAIN

IFTST2,	JMS I [GETC	/GET NEXT CHARACTER
	TAD CONDSW
	CIA
	DCA CONDTM	/SET NUMBER OF NESTED CONDITIONALS
	CLA CMA		/DECREMENT NUMBER OF NESTED CONDITIONALS
	TAD CONDSW
	DCA CONDSW
	TAD VALUE
IFTST1,	HLT		/SZA CLA OR SNA CLA
	JMP I (MAIN	/--EXIT TO MAIN--
IFTST5,	TAD CONDSW	/DONE WITH ALL CONDITIONALS IN NEST?
	TAD CONDTM
	SMA CLA
	JMP I (MAIN	/YES --EXIT TO MAIN--
	TAD CHAR
	TAD (-"<	/NO - GET NEXT CHARACTER
	SNA		/IS IT <?
	JMP IFTST6	/YES - HANDLE NEXT CONDITIONAL
	TAD ("<-">	/NO - IS IT >?
IFSZA,	SZA CLA
	JMP IFTST4	/NO - FINISH THIS CONDITIONAL
	CLL CLA CMA RAL	/AC=7776
IFTST6,	CMA
	TAD CONDSW
	DCA CONDSW
IFTST4,	JMS I [GETC	/GET NEXT CHARACTER
	JMP IFTST5


/HANDLER FOR IFDEF PSEUDO-OP

IFD,	TAD [10		/IFTST1, SNA CLA

/HANDLER FOR IFNDEF PSEUDO-OP

IFND,	TAD IFSZA	/IFTST1, SZA CLA
	DCA IFTST1
	JMS I [SPNOR	/IGNORE SPACES
IFTST7,	JMS I [TSTALP	/IS NEXT CHARACTER ALPHABETIC
	JMP IFTST8	/YES
	JMS I [ERROR	/NO - GENERATE IC ERROR MESSAGE
	IC
	TAD CHAR	/IS CHARACTER <?
	TAD (-"<
	SNA CLA
	JMP IFTST2	/YES - CONTINUE
	JMS I [GETC	/NO - GET NEXT CHARACTER
	JMP IFTST7

IFTST8,	JMS I [GETTAG	/PICK UP TAG - IS IT IN TABLE?
	CLA CMA		/NO
	DCA VALUE	/YES
	TAD TAG3	/WAS IT A PSEUDO-OP?
	SMA CLA
	JMP IFTST9	/NO
	JMS I [ERROR	/YES - GENERATE IP ERROR MESSAGE
	IP
	JMP IFTST9

CONDTM,

/PUT TAG IN SYMBOL TABLE

PUTTAG,	0
	TAD THISTG
	JMS I (SETFLD	/SET FIELD
	TAD TAG1
	DCA I TAGXR
	TAD TAG2
	DCA I TAGXR
	TAD TAG3
	DCA I TAGXR
	TAD VALUE2
	DCA I TAGXR
	CDF
	JMP I PUTTAG	/--RETURN--



/PUSHDOWN ROUTINE
/PUT NEW ENTRY ON PUSHDOWN STACK

PUSHA,	0
	DCA TEMP
	CLA CMA
	TAD PDLXR
	DCA PDLXR
	TAD PDLXR
	TAD (-PDLND
	SPA CLA		/IS LIST TOO FULL?
	JMP I (PUSHA1	/BE**FATAL ERROR**
	TAD TEMP	/NO - MAKE ENTRY
	DCA I PDLXR
	CLA CMA
	TAD PDLXR
	DCA PDLXR
	JMP I PUSHA	/--RETURN--

/TEST NUMERIC ROUTINE
/CALL WITH CHARACTER TO TEST IN "CHAR"
/SKIPS IF THE CHARACTER IS NOT NUMERIC

TSTNUM,	0
	TAD CHAR	/GET THE CHARACTER
	TAD [-"0
	SPA		/SKIPS IF >= 0
	JMP TSTNU1	/NOT A NUMBER
	TAD ("0-"9
	SMA SZA CLA	/SKIPS IF <=9
TSTNU1,	ISZ TSTNUM	/2ND EXIT - NOT A NUMBER
	CLA
	JMP I TSTNUM	/--RETURN--

/TEST ALPHANUMERIC ROUTINE
/CALL WITH CHARACTER IN "CHAR"
/SKIPS IF CHARACTER IS NOT ALPHANUMERIC

TSTALN,	0
	JMS I [TSTNUM	/IS IT NUMERIC
	JMP I TSTALN	/YES--RETURN--
	JMS I [TSTALP	/IS IT ALPHABETIC
	JMP I TSTALN	/YES--RETURN--
	ISZ TSTALN	/NEITHER
	JMP I TSTALN	/--RETURN--

/TEST ALPHABETIC ROUTINE
/CALL WITH CHARACTER IN "CHAR"
/SKIPS IF NOT ALPHABETIC

TSTALP,	0
	TAD CHAR
	TAD (-"A
	SPA		/SKIP IF =>A
	JMP TSTAL1	/<A
	TAD ("A-"Z
	SMA SZA CLA	/SKIP IF <=Z
TSTAL1,	ISZ TSTALP	/NO GOOD - 2ND EXIT
	CLA
	JMP I TSTALP	/--RETURN--

	PAGE

PUNVA1,	TAD [LOOKEX	/FIX PUNONE TO EXIT TO MAIN
	DCA I (PUNONE
	TAD [211	/OUTPUT TAB
	JMS I OERROR
	JMP I (DTORG1

/HANDLER FOR %
/DIVIDE BY REPEATED SUBTRACTION

OP6,	DCA TEMP
	TAD VALUE2
	CIA
	DCA VALUE2
	TAD VALUE
OP6A,	CLL
	TAD VALUE2	/SUBTRACT DIVISOR FROM DIVIDEND
	SNL		/DONE YET?
	JMP OP6B	/YES - EXIT
	ISZ TEMP	/NO - COUNT ONE MORE SUBTRACTION
	JMP OP6A	/SUBTRACT AGAIN
OP6B,	CLA
	TAD TEMP	/RESULT IS # OF SUBTRACTIONS
	JMP I (OP0+2

EJECT7,
/TELETYPE OUTPUT ROUTINE
/PRINT 1 CHARACTER

OTYPE1,	0
	DCA TTTT
	TAD TTTT
	JMS TOUT
	TAD TTTT
	TAD [-215	/WAS THE CHARACTER A CARRIAGE RETURN?
	SZA CLA
	JMP I OTYPE1	/NO--RETURN--
	TAD [212	/YES--OUTPUT A LINE FEED, TOO
	JMP OTYPE1+1

TTTT,	0


/HANDLER FOR XLIST PSEUDO-OP

XLISTY,	JMS XLISTZ	/ANY EXPRESSION?
	JMP XLIST1	/NO
	JMS I [EXP	/GET EXPRESSION
	TAD VALUE	/USE THE VALUE
XLIST2,	DCA XLISTX	/SET SWITCH
	JMP I [LOOKEX	/--EXIT TO MAIN--

XLIST1,	TAD XLISTX
	SNA CLA
	IAC		/FLIP IT
	JMP XLIST2



/HANDLER FOR EJECT PSEUDO-OP

EJECTX,	ISZ THISPG
	TAD PASS	/IS THIS PASS 3?
	SMA SZA CLA
	JMP EJECT2	/YES
EJECT1,	TAD CHAR	/NO - LOOK FOR NEXT NEGATIVE CHARACTER
	SPA CLA
	JMP I [LOOKEX	/--EXIT TO MAIN--
	JMS I [GETC	/GET NEXT CHARACTER
	JMP EJECT1

EJECT2,	JMS XLISTZ	/PASS 3 - IS THERE AN EXPRESSION?
	JMP EJECT3	/NO - EXIT
	JMS I (HEDCLR	/YES - CLEAR HEADING BUFFER
	TAD [-40
	DCA EJECT7	/SET UP FOR 40 NEW CHARACTERS
	TAD [HEADER-1
	DCA EJECT8	/SET HEADER BUFFER POINTER
	JMP EJECT4

EJECT6,	ISZ EJECT7	/FILLED 40 CHARACTERS YET?
	JMP EJECT4	/NO - KEEP FILLING
	CLA CMA		/YES - SKIP CHARACTERS TO
	DCA EJECT7	/END OF LINE
	JMP EJECT5

EJECT4,	TAD CHAR	/FILL HEADING BUFFER
	DCA I EJECT8
EJECT5,	CLA CMA
	DCA TXTSWT
	JMS I [GETC	/GET NEXT CHARACTER
	TAD CHAR	/END OF LINE?
	SMA CLA
	JMP EJECT6	/NO - KEEP FILLING
EJECT3,	JMS I [FORMFD	/GENERATE FORM FEED
	JMP I [LOOKEX	/--EXIT TO MAIN--

EJECT8=XREG1		/HEADER BUFFER POINTER



PUNVAL,	TAD PASS	/IS THIS PASS 2?
	SPA SNA CLA
	JMP I [LOOKEX	/YES--EXIT TO MAIN--
	JMP PUNVA1	/NO


/SEE IF EXPRESSION FOLLOWS XLIST
/SKIP ON EXPRESSION

XLISTZ,	0
	JMS I [SPNOR	/IGNORE TRAILING SPACES
	TAD CHAR
	TAD [-">	/IS THERE AN EXPRESSION?
	SNA CLA
	JMP I XLISTZ	/NO--RETURN--
	TAD CHAR
	SMA CLA
	ISZ XLISTZ	/YES - INCREMENT RETURN ADDRESS
	JMP I XLISTZ	/--RETURN--


/DUMMY ERROR ROUTINE
/TO SUPPRESS CERTAIN ERROR MESSAGES
/ON PASS 1

PERRO1,	0
	ISZ PERRO1	/SKIP ERROR MESSAGE POINTER
	JMP I PERRO1	/--RETURN--


/CONSTANTS FOR DECIMAL PRINT

DECIMAL
FORMF8,	-1000
	-100
	-10
OCTAL


/HANDLER FOR -

OP1,	TAD VALUE2
	CIA
	JMP I (OP0+1


OUTEM,	0
	TAD I SPTR
	TAD (-240!200	/IS IT A BLANK?
	SNA CLA
	JMP .+3
	TAD I SPTR
	JMS TOUT
	ISZ SPTR
	ISZ KNT
	JMP OUTEM+1
	JMP I OUTEM

	PAGE


/**********************************************************
/CODE UNIQUE TO PASSES 1 AND 2



/CONTINUATION OF FIXTAB HANDLER

FIXTAY,	TAD HIGHTG	/SET POINTERS TO TABLE
	CMA
	DCA TEMP3
	DCA THISTG
FIXTAX,	JMS I [FINDTG	/GET A TAG
	CLL CLA CMA RAR	/AC=3777
	AND TAG1
	TAD [4000	/SET BIT 0 OF FIRST WORD TO 1
	DCA TAG1	/RETURN IT TO TABLE
	JMS I [PUTTAG
	ISZ THISTG
	ISZ TEMP3	/DONE WITH TABLE YET?
	JMP FIXTAX	/NO
	JMP I [LOOKEX	/YES--EXIT TO MAIN--

/CONTINUATION OF EXPUNGE HANDLER
/ENTER ONLY ON PASS 1

EXPUNW,	DCA TEMP1
	DCA EXPUN2
	TAD HIGHTG
	CMA
	DCA TEMP3
EXPUNY,	TAD TEMP1
	DCA THISTG
	JMS I [FINDTG
	TAD TAG3
	JMP I EXPUNU

EXPUNU,	EXPUNV




EXPUN2,

/OUTPUT ONE REGISTER - BINARY
/ENTER WITH CONTENTS IN AC

PUNOUT,	0
	DCA PUNOU1
	TAD PUNOU1
	RTR
	RTR
	RTR
	AND [177
	JMS I OCHAR	/OUTPUT FIRST FRAME
	TAD PUNOU1
	AND [77
	JMS I OCHAR	/OUTPUT SECOND FRAME
	JMP I PUNOUT	/--RETURN--

PUNOU1,	0


/START PASS 2

START1,	TAD (-11
	DCA  KNT		/SIZE OF FILENAME
	TAD (SINCH	/ADDRESS OF SINCH
	DCA PTR
	TAD (BSLOT+1	/ADDRESS OF FILENAME TO CREATE
	DCA IPTR
MOTSIN,	TAD I IPTR	/GET CHAR
	CDF 10
	DCA I PTR	/PIT IN SINCH
	DCA I (BVERNO	/CLEAR THE VERSION NUMBER
	CDF 0
	ISZ PTR
	ISZ IPTR
	ISZ KNT		/DONE?
	JMP MOTSIN	/NO..
	TAD (BSLOT	/OPEN PASS2 OUTPUT FILE
	DCA IPTR	/FUDGE TO USE MOUNT ROUTINE
	JMS INTWT	/WAIT FOR ANY IO
	CLA CLL CML RTR
	AND BSLOT	/MOUNT BIT ON?
	SZA CLA
	JMS MOUNT	/YES..
	TAD BSLOT
	SNA
	JMP ONOFIL	/NO PASS 2 OUTPUT FILE
	CIF 10
	CALL (ENTER	/OPEN THE FILE
	JMP WRTERR
	JMS WRTMSG
	BINOP
	TAD BSLOT
	JMS TOUT
	JMS WRTMSG
	CRLFR
	TAD BSLOT
	DCA BCLOSW
	TAD (ISLOTS
	DCA IPTR
OOPLP,	TAD I IPTR	/A FILE?
	SNA CLA
	JMP BPA		/NO.. 
	TAD IPTR
	JMS CNAME	/CHECK FOR MATCH IN UNITS
	-1;BSLOT
	JMP .+5
	CLA CLL CMA RTR
	AND I IPTR
	TAD (2000	/TURN ON MOUNT BIT
	DCA I IPTR
	TAD IPTR
	TAD (12
	DCA IPTR
	JMP OOPLP
BPA,	DCA OUTINH
	TAD (-200
	DCA OUWDCT
	TAD (OBUFR
	DCA OUPTR
	SKP
ONOFIL,	ISZ OUTINH
	TAD [ERROR	/RESET PSEUDO-ERROR ROUTINE
	DCA PERROR	/TO ALLOW MESSAGES TO BE OUTPUT
	DCA PUNCHX	/CLEAR PUNCH INHIBIT
	JMP I ST1ST2

ST1ST2,	START2
BCLOSW,	0

	PAGE



	IBUFR=.


BEGING,	JMS WRTMSG
	INMSG
	TAD (ISLOTS	/POINT TO INPUT FILE LIST
	DCA HOLE	/POINTER TO CUURENT SLOT
	CLA CLL CMA RTL
	DCA CNT		/ALLOW 3 INPUT FILES
GETIN,	DCA I HOLE	/CLEAR FILE FLAGS
	TAD ("*
	JMS TOUT
	JMS GETLIN
	JMS SCNLIN
	JMP CLIN	/NULL RETURN
	JMP SYNERR	/X: NOTATION
	JMS ADDPAL	/ADD EXTENSION
	SKP		/GOOD FILE
	JMP GETIN	/SYNTAX ERROR
	JMS WRTMSG
	CRLFR
	TAD UNIT
	DCA I HOLE	/PUT INITIAL UNIT # IN
	TAD HOLE
	TAD (12
	DCA HOLE	/BUMP TO NEXT SLOT
	ISZ CNT		/3 FILES YET?
	JMP GETIN	/NO
CLIN,	JMS WRTMSG	/YES.. GET BINARY FILE
	BINMSG
	TAD (BSLOT
	DCA HOLE	/POINT TO BINARY SLOT
GETBIN,	DCA I HOLE	/INITIALLY CLEAR IT
	TAD ("*
	JMS TOUT
	JMS GETLIN
	JMS SCNLIN
	JMP CLBIN	/NULL BINARY
	JMS ECOIN	/X: NOTATION
	JMS ADDBIN	/FILE WITHOUT EXTENSION
	SKP		/GOOD FILE
	JMP GETBIN	/SYNTAX ERROR
	TAD UNIT	/STORE INITIAL UNIT FOR BINARY
	DCA I HOLE
CLBIN,	JMS WRTMSG
	LSTMSG
	TAD (LSLOT
	DCA HOLE	/POINT TO LISTING FILE
	DCA I HOLE	/CLEAR LISTING FLAGS
	DCA ZOTDIG	/SUPRESS 0: FUDGE FOR UNIT
GETLST,	TAD ("*
	JMS TOUT
	JMS GETLIN
	TAD (LBUFR
	JMS CNAME	/CHECK FOR A (CR)
	-1;TTY+3
	SKP
	JMP CLLIST	/YES.. NO LISTING
	TAD (LBUFR
	JMS CNAME	/CHECK FOR TTY
	-4;TTY
	JMP .+4
	CLA CMA
	DCA I HOLE	/INDICATE TTY SPECIFIED
	JMP CLLIST	/START ASSEMBLY
	TAD (LBUFR
	JMS CNAME
	-4;LPT		/CHECK FOR LINE PRINTER
	JMP .+4
	CLA CLL CMA RAL
	DCA I HOLE	/INDICATE LINE PRINTER SPECIFIED
	JMP CLLIST
	JMS WRTMSG	/GIVE ERROR MESSAGE
	ERR
	JMP GETLST	/TRY AGAIN
CLLIST,	JMS WRTMSG
	CRLFR
	JMP I (START2-1	/YES VIRGINIA, THERE IS A START
			/ TO THE ASSEMBLER

HOLE,	0


INMSG,	"-&177+400; "I; "N; "P; "U; "T; 240&177
	"F; "I; "L; "E; "S; 215&177+400; 212&177+4000
BINMSG,	215&177+400; 212&177+400
	"-; "B; "I; "N; "A; "R; "Y; 240&177
	"F; "I; "L; "E; 215&177+400; 212&177+4000

	PAGE


	LBUFR=OPTIM1

SCNLIN,	0		/HAS 5 RETURNS!!!
	TAD (LBUFR
	DCA PTR		/POINT TO INPUT BUFFER
	DCA FUDFLG	/ZERO A SKIP FLAG FOR EXIT
	TAD I PTR
	TAD (-215!200	/A (CR)?
	SNA CLA
	JMP I SCNLIN	/YES.. R1
	ISZ SCNLIN	/BUMP RETURN POINTER
	TAD I PTR
	DCA UNIT	/MUST BE UNIT AND GOOD DIGIT
	ISZ PTR
	TAD I PTR
	TAD (-":!200	/IS IT A COLON
	SZA CLA
	JMP SYNERR	/NO.. IT SHOULD HAVE BEEN
	ISZ PTR
	TAD I PTR
	TAD (-215!200	/NEXT CHAR A (CR)?
	SNA CLA
	JMP I SCNLIN	/YES.. X: RETURN   R2
	TAD HOLE
	DCA SPTR	/POINT TO ENTRY TO BLANK IT
	TAD (-11	/BLANK 9 CHARS
	DCA KNT
	ISZ SPTR
	TAD (240&177	/PUT BLANK IN
	DCA I SPTR
	ISZ KNT
	JMP .-4		/JUMP BACK TO BUMP SO THAT 1ST CHAR(UNIT)
			/ IS NOT MESSED UP
	TAD HOLE
	IAC
	DCA SPTR	/POINT TO NAME PART OF SLOT
	JMS LET		/MAKE SURE ITS A LETTER
	JMP SYNERR	/NO..
	DCA I SPTR	/YES.. ITS IN AC
	ISZ PTR
	ISZ SPTR
	TAD (-5		/NUMBER OF CHARS POSSIBLY REMAING IN NAME
	DCA KNT	
	JMS GETNAM	/SCAN AND MOVE TILL NEXT LET OR DIG
	TAD HOLE
	TAD (7
	DCA SPTR	/FORCE POINTING TO EXT FIELD
	TAD I PTR
	TAD (-".!200	/WAS EXT IMPLIED?
	SZA CLA
	JMP CRCK	/NO EXT.. MUST BE (CR)
	ISZ SCNLIN	/BUMP EXIT POINTER
	ISZ FUDFLG	/SAY SCNLIN HAS BEEN BUMPED BUT
			/ A SYNTAX ERROR STILL MAY OCCUR
	ISZ PTR
	CLA CLL CMA RTL
	DCA KNT		/3 CHAR EXTENSIONS
	JMS GETNAM	/GET THEM TO FILE TABLE
CRCK,	TAD I PTR	/AT THIS POINT WE SHOULD HAVE A (CR)
	TAD (-215!200	/ OR ITS A SYNTAX ERROR
	SNA CLA
	JMP NORMRT	/WE DO
	TAD FUDFLG
	SNA CLA
SYNERR,	ISZ SCNLIN	/POINT TO R3
	ISZ SCNLIN	/POINT TO R4
	JMS WRTMSG
	ERR
NORMRT,	ISZ SCNLIN	/POINT TO R5 IF SYNTAX
			/ OR POINT TO R4 IF EXT GIVEN
			/ OR POINT TO R3 IF NOT GIVEN
	JMP I SCNLIN	/RETURN

FUDFLG,	0

TTY,	"T&177; "T&177; "Y&177; 215&177
LPT,	"L&177; "P&177; "T&177; 215&177

/ CHECK FOR A LETTER ROUTINE
LET,	0		/R1-NOT A LETTER
	TAD I PTR	/R2-THE LETTER IN 8 BIT
	TAD (-"Z!200-1
	CLL
	TAD (32
	SNL CLA
	JMP I LET
	TAD I PTR
	ISZ LET
	JMP I LET


/ CHECK FOR A DIGIT ROUTINE
DIG,	0		/R1-NOT A DIGIT
	TAD I PTR	/R2-IS A DIGIT 0-9
	TAD (-"0!200
	CLL
	TAD (-12
	SZL CLA
	JMP I DIG
	TAD I PTR
	ISZ DIG
	JMP I DIG


/ GETS LETTERS OR DIGITS AND PUTS THEM IN THE INCH AT SPTR
GETNAM,	0
	JMS LET
	SKP		/CHECK FOR A DIGIT
	JMP STCHAR
	JMS DIG
	JMP I GETNAM
STCHAR,	DCA I SPTR
	ISZ SPTR
	ISZ PTR
	ISZ KNT
	JMP GETNAM+1
	JMP I GETNAM

	PAGE

	OBUFR=.

/ GETS AN INPUT LINE FROM THE TTY
GETLIN,	0		/R-GETS A LINE OF TEXT ENDED
	TAD (LBUFR	/-WITH A (CR)
	DCA PTR
GLINE,	JMS KIN
	DCA I PTR
	TAD I PTR
	TAD (-377!200	/A (RO)?
	SNA		/NO..
	JMP ROR
	TAD (377-215	/A (CR)?
	SNA		/NO..
	JMP I GETLIN	/YES.. RETURN
	TAD (215-225	/A (^U)?
	SNA CLA		/NO..
	JMP ZOTLIN
	TAD PTR
	CIA
	TAD (LBUFR
	SNA CLA
ZOTDIG,	JMP ZCOL
CHRIN,	TAD I PTR
	JMS TOUT
	ISZ PTR
	TAD PTR
	CIA
	TAD (LBUFR
	TAD (240&177
	SMA CLA
	JMP GLINE
	TAD ("?
	JMS TOUT
ZOTLIN,	JMS WRTMSG
	CRLFA
	JMP GETLIN+1



/ THE RUBOUT HANDLER
ROR,	CMA CLA
	TAD PTR
	DCA PTR
	TAD (LBUFR
	CIA
	TAD PTR
	SPA CLA
	JMP ZOTLIN
	TAD I PTR
	JMS TOUT
	JMP GLINE


/ THE 0: FUDGE
ZCOL,	JMS DIG
	SKP
	JMP CHRIN+1
	TAD ("0&177
	DCA I PTR
	ISZ PTR
	TAD ("0&177
	JMS TOUT
	TAD (":&177
	DCA I PTR
	ISZ PTR
	TAD (":&177
	JMS TOUT
	TAD I (KBDIN
	DCA I PTR
	JMP CHRIN



ADDBIN,	0
	JMS WRTMSG
	BINDOT
	TAD (BINDOT+1
	DCA PTR
	CLA CLL CMA RTL
	JMS MFNME
	JMP I ADDBIN
ADDPAL,	0
	JMS WRTMSG
	PALDOT
	TAD (PALDOT+1
	DCA PTR
	CLA CLL CMA RTL
	JMS MFNME
	JMP I ADDPAL
ECOIN,	0
	TAD (-6
	DCA KNT
	TAD (ISLOTS+1
	DCA SPTR
	JMS OUTEM
	TAD (ISLOTS+1
	DCA PTR
	TAD HOLE
	IAC
	DCA SPTR
	TAD (-6
	JMS MFNME
	JMP I ECOIN
MFNME,	0
	DCA KNT
	TAD I PTR
	AND (177
	DCA I SPTR
	ISZ PTR
	ISZ SPTR
	ISZ KNT
	JMP MFNME+2
	JMP I MFNME

	PAGE

BINDOT,	".&177; "B; "I; "N+4000
PALDOT,	".&177; "P; "A; "L+4000

CRLFA,	215&177+400; 212&177+400; "*&177+400+4000
LSTMSG,	215&177+400; 212&177+400
	"-; "L; "I; "S; "T; 240; "T; "O
	215&177+400; 212&177+4000

	PAGE

/END OF ONCE ONLY CODE
/**********************************************************



IOPEN,	0
	TAD PASS	/IS THIS PASS 3?
	SPA SNA CLA
	JMP NXTFLE	/NO
	JMS I (HEDCLR	/YES - CLEAR HEADING BUFFER
	TAD [-40
	DCA I (LSTCH6
	TAD [HEADER-1
	DCA I (LSTCH7
	DCA LSTCNT
NXTFLE,	JMS INTWT	/PURGE ALL ACTIVE IO
	TAD (12
	TAD IPTR
	DCA IPTR
	CLA CLL CML RTR
	AND I IPTR	/IS MOUNT BIT ON?
	SZA CLA
MNTIT,	JMS MOUNT	/ISSUE MOUNT MESSAGE FOR FILE
	CLA IAC
	TAD IPTR
	DCA LSPOT	/POINTER TO FILE NAME
	TAD I IPTR
	SPA		/WAS BACK SPACE BIT ON?
	
	JMP BCKVER	/YES... TRY TO QUICK ACCESS IT
	SNA
	JMP PHASE	/NO MORE INPUT AND NO $ SIGN
	CIF 10
	CALL (LOOKUP	/SEARCH CASSETTE FOR FILE
	CDF 0
LSPOT,	HLT
	JMP INERRX	/HARD ERROR DURING LOOKUP
	JMP MNTIT	/DIDN'T FIND ON THIS CASSETTE-MOUNT A NEW ONE
CEXIT,	CLA CLL CMA RAR
	AND I IPTR
	TAD (4000
	DCA I IPTR
	TAD IPTR
	JMS CNAME
	-1;BSLOT
	JMP .+5
	CLA CLL CMA RTR
	AND BSLOT
	TAD (2000
	DCA BSLOT
	DCA INEOF
	CLA CMA
	DCA INCHCT
	TAD (IBUFR
	DCA INBUFP
	JMS READ
	JMP I IOPEN

BCKVER,	CIF 10
	CALL (UTIL	/BACKSPACE FILE
	30
	JMP MNTIT	/ERROR BUT TRY ANOTHER WAY
	TAD (MNTIT
	DCA ERET
	TAD (HDSIZE	/SET UP TO READ A HEADER
	CDF CIF 10
	DCA I (BSIZE
	CDF 0
	CALL (HANDLER	/READ HEADER
	0		/READ INTO FIELD 0
	IBUFR
	JMP MNTIT
	JMS INTWT	/MAKE SURE IN CORE BEFORE WE USE IT
	TAD (BLSIZE	/RESTORE CORRECT BLOCKSIZE
	CDF 10
	DCA I (BSIZE
	CDF 0
	TAD LSPOT
	JMS CNAME
	-11;IBUFR
	SKP
	JMP CEXIT
	CLA CLL CMA RAR	/TURN OFF BACKSPACE BIT
	AND I IPTR
	DCA I IPTR
	JMP MNTIT+1

BINCLO,	215&177+400; 212; "B; "I; "N; "A; "R; "Y; 240
	"F; "I; "L; "E; 240; "C; "L; "O; "S; "E; "D; 215+400; 212+4000

	PAGE



/OUTPUT A CHARACTER TO OUTPUT DEVICE
/CALLED BY JMS I OCHAR
/WITH CHARACTER IN 8-BIT ASCII IN AC

OUTPT1,	PUNCHX		/PASS 2=PUNCHX; 3=XLISTX

OUTPUT,	0
	AND [377	/MASK OUT LEFT 4 BITS
	DCA OUTPT2	/STORE
	TAD I OUTPT1	/IS THIS PASS 3 AND
	SNA
	TAD OUTINH	/IS THIS COVERED BY XLIST?
	SZA CLA
	JMP I OUTPUT	/YES--RETURN--
	TAD OUTPT2	/NO - GET CHARACTER
	TAD (-211	/IS IT A TAB?
	SNA CLA
	JMP OUTPT3	/YES - OUTPUT SPACES
	JMS OUTPUX	/NO - OUTPUT CHARACTER
	TAD OUTPT2	/IS IT LINE FEED?
	TAD (-212
	SZA CLA
	JMP I OUTPUT	/NO--RETURN--
	TAD [7773	/YES - RESET LSTCNT
	DCA LSTCNT
	JMP I OUTPUT	/--RETURN--


/OUTPUT SPACES INSTEAD OF TAB

OUTPT3,	TAD [240
	DCA OUTPT2
	JMS OUTPUX	/OUTPUT SPACE
	TAD LSTCNT	/TAB STOPS ARE EVERY 8 SPACES
	AND [7
	SZA CLA
	JMP .-4
	JMP I OUTPUT	/--RETURN--

/OUTPUT THE CHARACTER
OUTPUX,	0
	TAD OUTPT2
	DCA I OUPTR
	ISZ OUPTR
	ISZ OUWDCT
	SKP
	JMS OUWRT	/BUFFER IS FULL, DUMP IT
	TAD OUTPT2
	JMS I (TEXT1	/PRINT IT IF PRINTABLE
	ISZ LSTCNT
OUTINH,	0		/WILL ALWAYS BE ZERO OR 1
	JMP I OUTPUX

P3O,	TAD OUTPT2
	JMS I (TEXT1
	ISZ LSTCNT
	NOP
	TAD OUTPT2
P3OF,	JMS I (LPOCHR
	JMP I OUTPUX
P3OT,	TOUT

OUPTR,	0
OUTPT2,	0
OUWDCT,	0

OUWRT,	0
	JMS INTWT
	TAD (WRTERR	/IF ERROR OCCURS ITS ALWAYS FATAL
	DCA ERET
	TAD BSLOT	/OUTPUT UNIT
	CIF 10
	CALL (HANDLER
	4000
OUBPTR,	OBUFR
	JMP WRTERR
	TAD (-200
	DCA OUWDCT	/RESET WORD COUNT
	TAD OUBPTR
	CIA
	TAD (OBUFR+OBUFR+200
	DCA OUPTR	/RESET OUTPUT POINTER
	TAD OUPTR
	DCA OUBPTR
	JMP I OUWRT	/RETURN

OCLOSE,	0
	TAD OUTINH
	SZA CLA
	JMP I OCLOSE	/NO OUTPUT
	TAD [200	/SEND A ^Z FOR END OF FILE
	JMS I OCHAR
	TAD OUWDCT	/CHECK IF THE ^Z CAUSED A WRITE
	TAD (200
	SZA CLA
	JMS OUWRT	/IT DIDN'T, WE HAVE TO WRITE THE BUFFER
	TAD (ERET-1
	DCA ERET
	TAD BSLOT
	CIF 10
	CALL (CLOSE	/CLOSE THE FILE
	JMP WRTERR	/CLOSE FAILED
	JMS WRTMSG
	BINCLO
	DCA BCLOSW
	JMP I OCLOSE

	PAGE


TOUT,	0
	JMS I (TTOCHR
	JMP I TOUT

KIN,	0		/GET A CHAR FROM TTY
	JMS I (KBDCHR
	JMP I KIN

INTWT,	0		/I-O WAIT ROUTINE
	CIF 10
	CALL (WAIT
LPLPLP,	JMP I ERET	/ERROR ON PREVIOUS OPERATION
	JMP I INTWT	/NO ERROR.. CONTINUE

ERET,	LPLPLP		/INITIALLY POINT TO TIGHT LOOP

/ WRITE OUT THE GIVEN MESSAGE
WRTMSG,	0		/R-TYPES THE GIVEN MSG
	TAD I WRTMSG	/THE ADDRESS OF THE MSG
	DCA WPTR
	ISZ WRTMSG
TNXT,	TAD I WPTR
	AND (777
	JMS TOUT
	TAD I WPTR
	SPA CLA		/NEG CHAR INDICATES END
	JMP I WRTMSG
	ISZ WPTR
	JMP TNXT
WPTR,	0

MOUNTM,	"-&177+400; "M; "O; "U; "N; "T; 240&177+4000
ERR,	"?&177+400
CRLFR,	215&177+400; 212&177+400+4000


READ,	0
	JMS INTWT
	TAD INEOF	/CHECK TO SEE IF ALREADY AT END
	SZA CLA		/ OF FILE
	JMP I READ
	TAD (INERRX
	DCA ERET
	CIF 10
	TAD I IPTR
	CALL (HANDLER
	0
INBUFP,	IBUFR
	JMP RDERR
	JMP I READ
INERRX,	AND (20
	SNA CLA
	JMP RDERR
	ISZ INEOF	/SIGNAL NO MORE INPUT FROM THIS FILE
	JMP I INTWT	/THIS WASN'T A REAL ERROR
			/CONTINUE LAST OPERATION...

IINIT,	0
	TAD (ISLOTS-12
	DCA IPTR
	ISZ FORMSW	/PAL8 DID SO I WILL...
	TAD [LINBUF+120
	DCA TXTPTR
	JMS IOPEN
	JMP I IINIT

RDERR,	CLA CLL
	JMP DERR

WRTERR,	AND (40
	SZA CLA
	JMP .+3
DERR,	TAD (DE
	JMP I [MONERR
	TAD (DF
	JMP .-2



CNAME,	0
	DCA PTR1
	TAD I CNAME
	DCA KNT
	ISZ CNAME
	TAD I CNAME
	DCA PTR2
	ISZ CNAME
CNM2,	TAD I PTR1
	CIA
	TAD I PTR2
	AND (177
	SZA CLA
	JMP I CNAME
	ISZ PTR1
	ISZ PTR2
	ISZ KNT
	JMP CNM2
	ISZ CNAME
	JMP I CNAME

PTR1,	0
PTR2,	0

	PAGE



ISLOTS,	ZBLOCK	37	/THE EXTRA WORD OF ZERO AT THE END OF
			/ THE TABLE SAVES THE TROUBLE OF 
			/ KEEPING A COUNT
BSLOT,	ZBLOCK	12
LSLOT,	ZBLOCK	2

INPUT,	0
	ISZ INCHCT
	JMP GETCHR
	TAD INEOF
	SZA CLA
GETFLE,	JMS IOPEN	/START NEW FILE
GETBUF,	TAD INBUFP
	DCA INPTR
	TAD INBUFP
	CIA
	TAD (IBUFR+IBUFR+200
	DCA INBUFP
	JMS READ	/THERE WERE NO MORE CHARS IN THE INPUT
			/ BUFFER, SO WE COME HERE TO READ ANOTHER
	TAD [-200
	DCA INCHCT	/NUMBER OF CHARS IN 1 BUFFER LOAD
GETCHR,	TAD I INPTR
	ISZ INPTR	/LEAVING THIS OUT WAS SOME BUG!!!!
	AND [177	/CONVERT TO 7 BIT
	SNA
	JMP INPUT+1	/IT WAS NULL- SKIP IT
	JMP I (LSTCH9

INCHCT,	0
INPTR,	0
INEOF,	0

BINOP,	215&177+400; 212; "B; "I; "N; "A; "R; "Y; 240
	"F; "I; "L; "E; 240; "O; "N; 240; "U; "N; "I; "T; 240&177+4000

UPC,	215&177+400; 212; "^; "C+4000

	IFNZRO .&7600-7200  <MONITOR OVERFLOW>


/**********************************************************
/PAGE 0 LITERALS AND POINTERS
/**********************************************************
	FIELD 1



/**********************************************************
/SYMBOL TABLE
/MUST REMAIN IN ALPHABETICAL ORDER
/**********************************************************

	*5160

SYMS,	5777			/TERMINATOR
	3777			/IMPOSSIBLE (LIMITING) SYMBOL
	5777
	0000

	"Z-300^45+"B-300+4000	/ZBLOCK
	"L-300^45+"O-300
	"C-300^45+"K-300+4000
	ZBLOCX

	"Z-300^45+4000+2000	/Z
	0
	0
	0000

	"X-300^45+"L-300+4000	/XLIST
	"I-300^45+"S-300
	"T-300^45+4000
	XLISTY

	"T-300^45+"S-300+4000	/TSK
	"K-300^45
	0
	6045

	"T-300^45+"S-300+4000	/TSF
	"F-300^45
	0
	TSF

	"T-300^45+"P-300+4000	/TPC
	"C-300^45
	0
	TPC

	"T-300^45+"L-300+4000	/TLS
	"S-300^45
	0
	TLS

	"T-300^45+"F-300+4000	/TFL
	"L-300^45
	0
	6040



	"T-300^45+"E-300+4000	/TEXT
	"X-300^45+"T-300
	4000
	TEXTX

	"T-300^45+"C-300+4000	/TCF
	"F-300^45
	0
	TCF

	"T-300^45+"A-300+4000	/TAD
	"D-300^45+4000
	0
	TAD 0

	"S-300^45+"Z-300+4000	/SZL
	"L-300^45
	0
	SZL

	"S-300^45+"Z-300+4000	/SZA
	"A-300^45
	0
	SZA

	"S-300^45+"W-300+4000	/SWP
	"P-300^45
	0
	7521

	"S-300^45+"T-300+4000	/STL
	"L-300^45
	0
	STL

	"S-300^45+"T-300+4000	/STA
	"A-300^45
	0
	STA

	"S-300^45+"R-300+4000	/SRQ
	"Q-300^45
	0
	6003

	"S-300^45+"P-300+4000	/SPA
	"A-300^45
	0
	SPA



	"S-300^45+"N-300+4000	/SNL
	"L-300^45
	0
	SNL

	"S-300^45+"N-300+4000	/SNA
	"A-300^45
	0
	SNA

	"S-300^45+"M-300+4000	/SMA
	"A-300^45
	0
	SMA

	"S-300^45+"K-300+4000	/SKP
	"P-300^45
	0
	SKP

	"S-300^45+"K-300+4000	/SKON
	"O-300^45+"N-300
	0
	6000

	"S-300^45+"G-300+4000	/SGT
	"T-300^45
	0
	6006

	"R-300^45+"T-300+4000	/RTR
	"R-300^45
	0
	RTR

	"R-300^45+"T-300+4000	/RTL
	"L-300^45
	0
	RTL

	"R-300^45+"T-300+4000	/RTF
	"F-300^45
	0
	6005

	"R-300^45+"M-300+4000	/RMF
	"F-300^45
	0
	RMF



	"R-300^45+"I-300+4000	/RIF
	"F-300^45
	0
	RIF

	"R-300^45+"I-300+4000	/RIB
	"B-300^45
	0
	RIB

	"R-300^45+"D-300+4000	/RDF
	"F-300^45
	0
	RDF

	"R-300^45+"A-300+4000	/RAR
	"R-300^45
	0
	RAR

	"R-300^45+"A-300+4000	/RAL
	"L-300^45
	0
	RAL

	"P-300^45+"A-300+4000	/PAUSE
	"U-300^45+"S-300
	"E-300^45+4000
	PAUSEX

	"P-300^45+"A-300+4000	/PAGE
	"G-300^45+"E-300
	4000
	PAGEX

	"O-300^45+"S-300+4000	/OSR
	"R-300^45
	0
	OSR

	"O-300^45+"C-300+4000	/OCTAL
	"T-300^45+"A-300
	"L-300^45+4000
	OCTALX

	"N-300^45+"O-300+4000	/NOPUNCH
	"P-300^45+"U-300
	"N-300^45+"C-300+4000
	NOPUNX



	"N-300^45+"O-300+4000	/NOP
	"P-300^45
	0
	NOP

	"M-300^45+"Q-300+4000	/MQL
	"L-300^45
	0
	7421

	"M-300^45+"Q-300+4000	/MQA
	"A-300^45
	0
	7501

	"L-300^45+"S-300+4000	/LSF
	"F-300^45
	0
	6661

	"L-300^45+"S-300+4000	/LSE
	"E-300^45
	0
	6663

	"L-300^45+"P-300+4000	/LPC
	"C-300^45
	0
	6664

	"L-300^45+"L-300+4000	/LLS
	"S-300^45
	0
	6666

	"L-300^45+"I-300+4000	/LIF
	"F-300^45
	0
	6667

	"L-300^45+"I-300+4000	/LIE
	"E-300^45
	0
	6665

	"L-300^45+"C-300+4000	/LCF
	"F-300^45
	0
	6662



	"L-300^45+"A-300+4000	/LAS
	"S-300^45
	0
	LAS

	"K-300^45+"S-300+4000	/KSF
	"F-300^45
	0
	KSF

	"K-300^45+"S-300+4000	/KSEN
	"E-300^45+"N-300
	0
	6702

	"K-300^45+"S-300+4000	/KSDR
	"D-300^45+"R-300
	0
	6701

	"K-300^45+"S-300+4000	/KSBF
	"B-300^45+"F-300
	0
	6703

	"K-300^45+"S-300+4000	/KSAF
	"A-300^45+"F-300
	0
	6705

	"K-300^45+"R-300+4000	/KRSB
	"S-300^45+"B-300
	0
	6707

	"K-300^45+"R-300+4000	/KRS
	"S-300^45
	0
	KRS

	"K-300^45+"R-300+4000	/KRB
	"B-300^45
	0
	KRB

	"K-300^45+"L-300+4000	/KLSA
	"S-300^45+"A-300
	0
	6704



	"K-300^45+"I-300+4000	/KIE
	"E-300^45
	0
	6035

	"K-300^45+"G-300+4000	/KGOA
	"O-300^45+"A-300
	0
	6706

	"K-300^45+"C-300+4000	/KCLR
	"L-300^45+"R-300
	0
	6700

	"K-300^45+"C-300+4000	/KCF
	"F-300^45
	0
	6030

	"K-300^45+"C-300+4000	/KCC
	"C-300^45
	0
	KCC

	"J-300^45+"M-300+4000	/JMS
	"S-300^45+4000
	0
	JMS 0

	"J-300^45+"M-300+4000	/JMP
	"P-300^45+4000
	0
	JMP 0

	"I-300^45+"S-300+4000	/ISZ
	"Z-300^45+4000
	0
	ISZ 0

	"I-300^45+"O-300+4000	/ION
	"N-300^45
	0
	ION

	"I-300^45+"O-300+4000	/IOF
	"F-300^45
	0
	IOF



	"I-300^45+"F-300+4000	/IFZERO
	"Z-300^45+"E-300
	"R-300^45+"O-300+4000
	IF0

	"I-300^45+"F-300+4000	/IFNZRO
	"N-300^45+"Z-300
	"R-300^45+"O-300+4000
	IFN0

	"I-300^45+"F-300+4000	/IFNDEF
	"N-300^45+"D-300
	"E-300^45+"F-300+4000
	IFND

	"I-300^45+"F-300+4000	/IFDEF
	"D-300^45+"E-300
	"F-300^45+4000
	IFD

	"I-300^45+"A-300+4000	/IAC
	"C-300^45
	0
	IAC

	"I-300^45+4000+2000	/I
	0
	0
	0400

	"H-300^45+"L-300+4000	/HLT
	"T-300^45
	0
	HLT

	"G-300^45+"T-300+4000	/GTF
	"F-300^45
	0
	6004

	"G-300^45+"L-300+4000	/GLK
	"K-300^45
	0
	GLK

	"F-300^45+"I-300+4000	/FIXTAB
	"X-300^45+"T-300
	"A-300^45+"B-300+4000
	FIXTBX



	"F-300^45+"I-300+4000	/FIXMRI
	"X-300^45+"M-300
	"R-300^45+"I-300+4000
	FIXMRX

	"F-300^45+"I-300+4000	/FIELD
	"E-300^45+"L-300
	"D-300^45+4000
	FIELDX

	"E-300^45+"X-300+4000	/EXPUNGE
	"P-300^45+"U-300
	"N-300^45+"G-300+4000
	EXPUNX

	"E-300^45+"N-300+4000	/ENPUNCH
	"P-300^45+"U-300
	"N-300^45+"C-300+4000
	ENPUNX

	"E-300^45+"J-300+4000	/EJECT
	"E-300^45+"C-300
	"T-300^45+4000
	EJECTX

	"D-300^45+"E-300+4000	/DECIMAL
	"C-300^45+"I-300
	"M-300^45+"A-300+4000
	DECIMX

	"D-300^45+"C-300+4000	/DCA
	"A-300^45+4000
	0
	DCA 0

	"C-300^45+"M-300+4000	/CML
	"L-300^45
	0
	CML

	"C-300^45+"M-300+4000	/CMA
	"A-300^45
	0
	CMA

	"C-300^45+"L-300+4000	/CLL
	"L-300^45
	0
	CLL



	"C-300^45+"L-300+4000	/CLA
	"A-300^45
	0
	CLA

	"C-300^45+"I-300+4000	/CIF
	"F-300^45
	0
	CIF

	"C-300^45+"I-300+4000	/CIA
	"A-300^45
	0
	CIA

	"C-300^45+"D-300+4000	/CDI
	"I-300^45
	0
	6203

	"C-300^45+"D-300+4000	/CDF
	"F-300^45
	0
	CDF

	"C-300^45+"A-300+4000	/CAM
	"M-300^45
	0
	7621

	"C-300^45+"A-300+4000	/CAF
	"F-300^45
	0
	6007

	"B-300^45+"S-300+4000	/BSW
	"W-300^45
	0
	7002

	"A-300^45+"N-300+4000	/AND
	"D-300^45+4000
	0
	AND 0

	"A-300^45+"C-300+4000	/ACL
	"L-300^45
	0
	7701



	4001			/TERMINATOR
	0000			/IMPOSSIBLE (LIMITING) SYMBOL
	4000
	0000

SYME=.
	IFNZRO SYME-6000 <STERR,	WRONG!!!>

/**********************************************************
/TOP OF SYMBOL TABLE
/**********************************************************


	FIELD	0
	*200		/SELF STARTING ADDRESS