/2 PAL8 ASSEMBLER FOR OS/8 MONITOR	VERSION 13
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C) 1970,1971,1972,1973,1974,1975 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/1-OCT-75				MB/MB/SM/MB/RL/JR/SR

DECIMAL

VERSION=	13
SUBVERSION=	"A

OCTAL

/PAL8 IS AN 8K THREE PASS ASSEMBLER DESIGNED 
/TO BE COMPATIBLE WITH THE OS/8 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.

/PAL8 IS COMPATIBLE IN MOST RESPECTS WITH PAL III, MACRO-8
/4K PAL-D, AND 8K PAL-D, AS WELL AS THE CROSS-ASSEMBLER PAL10.

	IFNDEF HASH<HASH=1>	/DEFINE FOR HASH SYMBOL TABLE
/SET HASH=0 TO GET OLD PAL8 WAY OF HANDLING SYMBOL TABLE

/MAINTENANCE RELEASE CHANGES:

/1.	INCLUDED JIM ROTH'S HASH TABLE MODIFICATIONS
/2.	ALLOWED /B TO WORK PROPERLY [SEQ #2 PATCH FROM AUG '74 DSN]
/3.	PUT CREFLS.TM ON SYS: NOT DSK: [PATCH SEQ #3, SEP '74 DSN]
/4.	FIXED 7TH LEVEL CHECKSUM BIT [PATCH SEQ #7, MARCH '75 DSN]
/5.	ALLOWED PAL8 TO RESTART BEFORE CD EXECUTED [DSN APR '75, SEQ #8]
/6.	FIXED /F SO IT WORKS [PATCH SEQ #9, DSN APRIL 1975]
/7.	FIXED /W SO IT DOESN'T REMEMBER TOP OF PAGE [DSN OCT '75]
/8.	FIXED BUG RE MULTIPLE NON-RES INPUT HANDLERS
/9.	CHANGED VERSION # TO V10, EDIT 1, 1975 COPYRIGHT
/10.	ADDED DOCUMENTATION ON LOCATION OF HANDLERS AND BUFFERS
/11.	CORE ALLOCATION:
/	WITHOUT /K, ALL CORE BUT 10000-11777 USED FOR SYMBOLS
/	WITH /K, USES ALL CORE (AND SWAPS USR BETWEEN PASSES)
/	UNDER BATCH, N5000-N7777 IS RESERVED FOR BATCH RESIDENT AS WELL
/12.	/7 WITH HASH FEATURES PRINTS 7 COLUMN SYMBOL TABLE
/13.	14-DEC-75 JR: FIXED TYPO IN /W CODE IN LITERAL DUMP ROUTINE

/JR	14-APR-77 ADDED STANDARD DATE FORMAT TO HEADING
/COMMAND DECODER RULES:

/*BINARY(.BN),LISTING(.LS),CREF(.LS)<SOURCE(.PA),.../OPTIONS

/OPTIONS:
/B	BYTE SHIFT	- ! IS 6 BIT SHIFT (!=^100+)
/C	CREF AFTER	- "CREFLS.TM" CREATED IF NO CREF
/D	DDT TYPE SYMBOL	- ONLY IF LISTING
/E	'LG' ERROR	- LINKS ARE ERRORS
/F	NO TEXT FILL	- NO EXTRA 0 FILL IN 'TEXT'
/G	LOAD+GO AFTER	- SAME AS /L, BUT /G PASSED TO ABSLDR
/H	NO PAGING	- ONLY IF LISTING
/J	JUST WHAT LOADS	- INHIBITS LISTING OF UNASSEMBLED CODE
/K	CHECK FOR MORE THAN 8K OF CORE (DEFAULT IS 8K)
/L	LOAD AFTER	- "PAL8BN.TM" CREATED IF NO BINARY
/N	NO LISTING	- ONLY IF LISTING
/O	NO 200 ORG	- NO AUTOMATIC 200 ORIGIN AFTER 'FIELD'
/S	NO SYMBOL TABLE	- ONLY IF LISTING
/T	CR-LF NOT FF	- ONLY IF LISTING
/W	WIPE LITERALS	- INHIBITS REMEMBERING OF LITERAL BOUNDS

/PERMANENT PATCH LOCATIONS FOR THE ABOVE SWITCHES ARE SYMBOLS
/OF THE FORM Z(SW)(PATCH) - E.G. ZT7640 IS THE LOC TO PATCH TO 7640
/TO REVERSE THE POLARITY OF THE "T" SWITCH.

/PSEUDO-OPS:
/DECIMAL	RADIX TO BASE 10
/DEVICE		2 WORD DEVICE CODE
/DTORG		TYPESETTING TAPE ORIGIN
/EJECT		SKIPS TO A NEW PAGE, AND IF ANY TEXT FOLLOWS,
/		THAT TEXT BECOMES THE NEW HEADER LINE
/ENPUNCH	ENABLE PUNCHING
/EXPUNGE	REMOVE ALL SYMBOLS
/FIELD		SET FIELD
/FILENAME	4 WORD FILE CODE
/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
/RELOC		ASSEMBLE FOLLOWING CODE AS IF LOC = ARG OF RELOC
/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' OR BYTE SHIFT
/  (SPACE)	DELIMITER OR INCLUSIVE OR
/^		MULTIPLY (REPEATED ADDITION)
/%		DIVIDE (REPEATED SUBTRACTION)
/DEFINITIONS

ASWAP=	40		/WATCH THIS SWAP AREA!!
MDATE=	7666		/MONITOR DATE
BIPCCL=	7777		/DATE EXTENSION AND BATCH IN PROG FLG IN FIELD 0
MPARAM=	7643		/COMMAND DECODER OPTION LIST
DCB=	7760		/DEVICE CONTROL BLOCK
JSBITS=	7746		/JOB STATUS WORD
BATOUT=	7400		/BATCH LOG OUTPUT ROUTINE IN BATCH RESIDENT
LNPRPG=	70		/56 LINES PER PAGE
HEDLEN=	50		/40 CHARACTERS IN PAGE TITLE
			/(MUST BE A MULTIPLE OF 8)

AC7776=	STA CLL RAL
AC7775=	STA CLL RTL
AC4000=	STL CLA RAR
AC3777=	STA CLL RAR
AC2000=	STL CLA RTR
AC0002=	STL CLA RTL


/TABLE OF ERROR MESSAGE DEFINITIONS


IZ= "I-240^100+"Z-240	/ILLEGAL PAGE ZERO REFERENCE
CF= "C-240^100+"F-240	/CREF.SV NOT FOUND
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
LD= "L-240^100+"D-240	/ABSLDR.SV NOT FOUND
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
LG= "L-240^100+"G-240	/LINK GENERATED



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

*0
INT,	15
	CIF 30		/SYMBIONT CODE
	JMP .-1
PTR,	0		/V3C USED BY
KNTR,	0		/INPUT ROUTINE
OCTPR1,	0
OCTPR3,	0
FORMF6,	0

/AUTOINDEX REGISTERS
/PRESET FOR ONCE ONLY CODE

*10
PDLXR,	PDLST		/PUSH-DOWN AUTO INDEX REGISTER
TAGXR,	SWAP1-1		/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,	SWAP2-1
LAST3,	IFZERO	HASH	<SYMPRT+4-1>
	IFNZRO	HASH	<SYMNWP-1>
LAST4,	IFZERO	HASH	<SYMPR9-2-1>
	IFNZRO	HASH	<SYMDDT-1>

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

LITPTR,	200		/LITERAL POINTER

RADIX,	0		/7777 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
OFFSET,	0		/LOCATION COUNTER OFFSET FROM "LOC"
OFSBUF,	0		/LOCATION COUNTER OFFSET BUFFER
STARSW,	0		/-1 IF NEXT ORIGIN SHOULD BE INHIBITED

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
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-1	/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
INCTL,	601		/CONTROL WORD - FOR OS/8 I/O
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
VALUEX,	0	/XCODE
ERROR5,	0		/USED BY PACKED ASCII PRINT ROUTINE
BINSRT,	0		/BINARY OR LISTING STARTING
ERCNT,	0		/ERROR COUNTER
LINK,	0		/LINK COUNTER
	IFNZRO HASH<
TAGMAX,	0		/SET TO PRIME # EQ TO MAX # SYMS
	>
	PAGE
/STARTING ADDRESS OF PAL8 (0200)
/CHAINING ADDRESS (0201)

NAME1,	JMP I NAME3	/NAME1-NAME3 USED LATER
NAME2,	JMP I GETTA2	/TO STORE TAGS AS THEY ARE BUILT
NAME3,	BEGIN		/V3C
GETTA2,	NOCD		/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,	STA		/7777 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
/AC=7777 ON RETURN IF TAG NOT FOUND, 0 IF FOUND

GETTAG,	0
	DCA NAME1	/CLEAR BUILD AREA
	DCA NAME2
	DCA NAME3
	TAD [NAME1
	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
	ISZ GETTA4	/BUMP TO NEXT WORD
GETTA1,	JMS I [GETC	/GET NEXT CHARACTER
	JMS I (TSTALN	/IS IT ALPHANUMERIC?
	JMP GETTG1	/YES - KEEP BUILDING
	IFZERO HASH<
	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
	AC3777
	AND TAG2	/YES - GET WORD 2
	CLL CIA
	TAD NAME2	/DOES IT MATCH?
	SZA CLA
	JMP GETTG2	/NO - TRY NEXT TAG
	AC3777
	AND TAG3	/YES - DOES IT MATCH?
	CLL CIA
	TAD NAME3
	SZA CLA
	JMP GETTG2	/NO - TRY NEXT TAG
	JMP I GETTAG	/YES--RETURN--
GETTG3,	AC7776
	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
	STA		/AC=7777 MEANS NOT FOUND
	JMP I GETTAG	/--RETURN--
	>
	IFNZRO HASH<
	PRIME=TAGMAX

GETTGH,/JMS I	[TLYREF	/HACK ONLY
	TAD NAME1	/HASH OUR NAME
	CLL RTL
	TAD	NAME2
	RTL
	TAD	NAME3
	RTL
	TAD	NAME1
	JMS	PROBE	/NOW PROBE THE TABLE
	TAD	NAME1	/RE HASH THE NAME FOR A STEPSIZE
	CLL RAL
	RTL
	TAD	NAME2
	CLL		/CALC MODULO PRIME INLINE
	TAD	MPRIME
	SZL
	JMP	.-3
	TAD	PRIME
	SNA
	IAC		/STEPSIZE MUST BE NON ZERO!
	DCA	CRPDEL
PRBLUP,	CLL
	TAD	THISTG	/BUMP THE POINTER RANDOMLY
	TAD	CRPDEL
	SZL		/PROTECT AGAINST WRAP AROUND
	TAD	MPRIME	/PROBABLY UNOPTIMAL SOLUTION
	JMS	PROBE
	JMP	PRBLUP

PROBE,	0
	CLL
	TAD	MPRIME
	SZL
	JMP	.-3
	TAD	PRIME
	DCA	THISTG	/THISTG MODULO PRIME
/	JMS I	[TLYPRB	/HACK ONLY
	JMS I	[FINDTG	/GO GET IT
	TAD	[1777	/MASK THE TYPE BITS OUT
	AND	TAG1	/IS THERE ONE?
	SNA
	JMP	NOTFND	/NO EXIT POINTING AT IT
	CIA		/YES, DO A COMPARE
	TAD	NAME1
	SZA CLA
	JMP I	PROBE
	AC3777
	AND	TAG2
	CIA
	TAD	NAME2
	SZA CLA
	JMP I	PROBE
	AC3777
	AND	TAG3
	CIA
	TAD	NAME3
	SZA CLA
	JMP I	PROBE	/FOUND EXIT WITH AC CLEAR
	JMP I	GETTAG
NOTFND,	STA		/NOT FOUND EXIT WITH AC SET
	JMP I	GETTAG

CRPDEL,	0
MPRIME,	0		/INITIALIZED BY ONCE ONLY CODE FOR MACHINE AT HAND
	>


GETTA3,	DCA GETTA2	/SAVE CHAR
	TAD GETTA2
	CLL RTL		/*4
	RAL		/*10
	TAD GETTA2	/*11
	RTL		/*44
	TAD GETTA2	/*45
	DCA I GETTA4	/SET LEFT SIDE
	TAD GETTA4
	TAD (-GETTA2
	SZA CLA		/IS THIS AN OVERFLOW (>6) CHAR?
	STA		/NO - SET SWITCH TO RIGHT HALF
	DCA GETTA2	/YES - LEAVE SWITCH AT LEFT HALF
	JMP GETTA1

GETTA4,	NAME1
/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,	AC4000
	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
/OUTPUT 2 CHARACTER ERROR CODE

ERROR1,	0
	DCA ERROR5
	TAD ERROR5
	JMS I [RTL6
	RAL
	AND [77
	TAD [240	/CONVERT SIXBIT TO ASCII
	JMS I OERROR	/OUTPUT FIRST CHAR
	TAD ERROR5
	AND [77
	TAD [240
	JMS I OERROR	/OUTPUT SECOND CHAR
	JMP I ERROR1	/--RETURN--

/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
	AND [7
	DCA FLDIND	/STORE FOR LISTING
	TAD VALUE
	AND [30
	DCA VALUEX
	TAD PASS	/IS THIS PASS 2?
	SZA CLA
	JMP FIELDY	/NO - PREPARE TO EXIT
	JMS I [XCHANG	/XCODE
	TAD FLDIND	/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

/CHANGE LAST 2 LOCATIONS TO:
/	CLA
/	JMP STAR1+1
/FOR INDAC GROUP TO OMIT RE-ORIGIN
/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 STAR3-1

PAGEY,	TAD LOC		/NO ARGUMENT - FIND NEXT PAGE
	TAD [177
	AND [7600
STAR3,	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
	DCA LININD
	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 [ICMESG	/NO - GENERATE IC MESSAGE, GET NEXT CHAR
	JMP FIXMRX+1	/KEEP LOOKING FOR ALPHABETIC CH. OR END OF LINE
FIXMR1,	JMS I [GETTAG	/PICK UP TAG
	DCA ALPHAI	/STORE UNDEFINED SWITCH
	SKP
FIXMR2,	JMS I [ICMESG
	JMS I [SPNOR	/IGNORE SPACES
	TAD CHAR	/WAS CHARACTER = ?
	TAD (-"=
	SZA CLA
	JMP FIXMR2	/NO - PRINT IC MESSAGE AND KEEP LOOKING
			/FALL INTO EQUALS PROCESSOR
/HANDLER FOR =

	AC4000		/FALL INTO HERE FROM FIXMRI
EQUAL,	JMS I [PUSHA	/PUSH FIXMRI FLAG
	JMS I [GETC	/GET NEXT CHARACTER
	TAD I [NAME1	/STORE THE SYMBOL NAME
	JMS I [PUSHA	/ON THE PUSH DOWN LIST
	TAD I (NAME2
	JMS I [PUSHA
	TAD I (NAME3
	JMS I [PUSHA
	TAD THISTG	/AND ITS PRESENT (OR FUTURE)
	JMS I [PUSHA	/POSITION IN THE SYMTAB
	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 SYMBOL TABLE POSITION
	TAD I PDLXR	/RESTORE TAG NAME
	DCA I (NAME3
	TAD I PDLXR
	DCA I (NAME2
	TAD I PDLXR
	DCA I [NAME1
	ISZ UNDFSW	/WAS ANY PART OF DEFINITION UNDEFINED?
	JMP EQUAL3	/NO
	JMS I PERROR	/YES - GENERATE IE ERROR MESSAGE
	IE
	ISZ PDLXR	/CLEAR EXTRA WORD FROM PDL
	JMP I [PUNVAL	/FORGET ABOUT DEFINING TAG
/MORE = PROCESSING

EQUAL3,	ISZ ALPHAI	/WAS TAG DEFINED BEFORE?
	JMP .+3		/YES - CHECK FOR ILLEGAL REDEFINITION
	JMS I [INSRTG	/NO - INSERT TAG INTO SYMBOL TABLE
	JMP EQUAL2	/AND BYPASS ILLEGAL REDEF CHECK
	JMS I [FINDTG	/PUT TAG IN TAG1-TAGE AND VALUE2
	TAD VALUE
	CIA
	TAD VALUE2
	SZA CLA		/WERE DEFINITIONS THE SAME?
	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
	AC3777
	AND TAG2	/CLEAR OLD FIXMRI BIT
	TAD I PDLXR	/INSERT NEW ONE
	DCA TAG2
	JMS I [PUTTAG	/STORE TAG
	JMP I [PUNVAL	/SEE ABOUT DUMPING SOURCE CODE
	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 (INPUT	/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?
	SZA
	TAD (211-240	/OR A SPACE?
	SZA CLA
	JMP GETC9	/NO-NOT ANYTHING SPECIAL
	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,	AC4000
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
	JMP GETC17	/NO
	DCA CONDSW	/STORE UPDATED CONDITIONAL LEVEL
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 <?
	SNA CLA
	STA		/YES - INCREMENT CONDITIONAL COUNTER
	JMP GETC13	/NO - KEEP LOOKING


/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 I LINPRT	/YES - END LINE
	JMS I OERROR	/NO - OUTPUT CHARACTER
	DCA I [LINBUF	/CLEAR OUT 1ST CHAR IN LINE AS "PRINTED" FLAG
	JMP LINPR1

/HANDLE PHASE ERROR
/AND ALL ERROR EXITS TO MONITOR

SYMOFL,	CLA
	TAD (SE		/SYMBOL TABLE EXCEEDED MESSAGE
MONERR,	DCA MONER1	/ERROR IS SERIOUS ENOUGH TO
PHASE,	TAD (OTYPEO	/ CAUSE IMMEDIATE RETURN TO
	DCA OERROR	/ MONITOR
	JMS I [ERROR
MONER1,	PH		/STORE ERROR TYPE HERE
	JMP I [7600	/***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
/**********************************************************
/THIS AREA IS SWAPPED OUT DURING PASS 1 AND 2
/** NO LITERALS IN THIS PAGE, AS THERE IS A PAGE OVERLAYING IT **

SWAP1=.

/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
LISOU2,	0
/FORM FEED OUTPUT ROUTINES

FORMFD,	0
	TAD LINCNT	/GET LINE COUNTER
	TAD FORMLN
	SNA CLA		/ARE WE AT TOP OF PAGE?
	JMP I FORMFD	/YES - NO NEED FOR FORM FEED
	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 MINUS	/OUTPUT ------
	JMS I OCHAR
	ISZ LINCNT	/* NEXT 3 LOCS CHANGED IF NO /T OR TTY:
FORMF1,	JMP .-3		/* STA
	TAD [-4		/* DCA LINCNT	/GENERATE ONE FORM FEED
	DCA LINCNT	/* STA		/TURN CR INTO FF
	JMS CRLF	/OUTPUT CR/LF OR FF/LF
	ISZ LINCNT
	JMP CRLF1	/OUTPUT LINE FEED
	TAD FORMLN
	CIA
	DCA LINCNT
FORM22,	TAD [HEADER-1	/OUTPUT HEADER
	DCA XREG2
	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 [-HEDLEN	/DONE "HEDLEN" CHARACTERS YET?
	SZA CLA
	JMP FORM30	/NO-CONTINUE
	TAD FORMHD	/YES-START SYSTEM HEADER
	JMP FORM22	/WHICH STARTS AT HEADER+HEDLEN

FORMLN,	LNPRPG
FORMHD,	HEDLEN
MINUS,	"-
/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 "HEDLEN" 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 MINUS	/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
FORM12,	DCA FORMF7	/START WITH 0
	JMP .+3
FORMF5,	DCA FORMF6
	ISZ FORMF7	/ADD 1 TO DIGIT
	TAD I CRLF	/SUBTRACT 1000, 100, OR 10
	SNA
	JMP FORM11	/0 IS END OF TABLE - NO MORE DIGITS
	TAD FORMF6
	SMA		/OVERFLOW
	JMP FORMF5	/NO-KEEP SUBTRACTING
	CLA		/YES-DIGIT DONE
	ISZ CRLF	/BUMP LIST POINTER
	TAD FORMF7	/WAS DIGIT A 0?
	SNA
	JMP FORM12	/YES
	TAD ["0		/NO-MAKE IT ASCII
	JMS I OCHAR	/OUTPUT DIGIT
	AC4000
	JMP FORM12	/4000 IN AC FORCES SIGNIFICANCE

FORM11,	TAD FORMF6	/GET LAST DIGIT (UNITS PLACE)
	TAD ["0
	JMS I OCHAR	/OUTPUT DIGIT
	JMP I FORMF4	/--RETURN--

FORMM6,	-6
FORM8F,	FORMF8
/OUTPUT CARRIAGE RETURN/LINE FEED
/ENTER WITH AC=-1 TO GENERATE F/F LF

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

/CLEAR PAGE HEADING BUFFER

FORMF7,
HEDCLR,	0
	TAD [-HEDLEN	/SET HEADING BUFFER
	DCA HEDCL2	/TO TABS
	TAD [HEADER-1
	DCA XREG2
	TAD [211
	DCA I XREG2
	ISZ HEDCL2
	JMP .-3
	JMP I HEDCLR	/--RETURN--
	PAGE
/SYMBOL TABLE OUTPUT (COLUMNAR)
			/*CODE TO GENERATE DDT COMPATIBLE*
			/**SYMBOL TABLE--SUBSTITUTED WITH*
			/**ONCE ONLY CODE IF NEEDED*******
	IFZERO	HASH<

SYMPRT,	0
	ISZ EDITPG			/NEW PAGE
	DCA THISPG
	JMS I [FORMFD
	TAD SMIN67	/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 SYMPRB
SYMPR1,	TAD [1777
	AND TAG1			/OUTPUT TAG
	JMS I SDIV45
	TAD TAG2
	JMS I SDIV45
	TAD TAG3
	JMS I SDIV45
	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
SYMPRB,	ISZ SYMPR7	/JMS I OERROR
	JMP SYMPRA	/JMS SYMPR9+6
HSWIT2,	JMS I [FORMFD	/DCA LINCNT	/0 IF NOT /H
	TAD SMIN67	/JMP I SYMPRT	//--RETURN--
	DCA SYMPR7	/0
	TAD SYMOFS	/TAD [-200
SYMPRA,	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

SDIV45,	DIV45
SMIN67,	1-LNPRPG
SYMPR0,	TAD SMIN67
	DCA SYMPPB
	JMS SYMPPP	/SKIP 67(8) SYMBOLS
	JMP SYMPR9
	ISZ SYMPPB
	JMP .-3
	JMS I [ERROR1
	JMS I [ERROR1
	JMS I [ERROR1
	JMP SYMPR1	/GO PRINT THE 67TH(8) SYMBOL

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

SYMPPP,	0
	ISZ THISTG
SYMOFS,	245
	TAD THISTG
	CLL CIA
	TAD HIGHTG
	SNL CLA
	JMP I SYMPPP	/--RETURN--
	JMS I [FINDTG
	AC4000
	AND TAG1
	TAD TAG3
	SPA SZL CLA
	JMP SYMPPP+1
	ISZ SYMPPP
	JMP I SYMPPP	/--RETURN--
/SYMNCL,	-4	/DEFAULT IN LIU OF =N OPTION
/SYMOFS,	245	/OFFSET TO FIRST SYM ON NEXT PAGE

	>
	IFNZRO	HASH<

SYMPRT,	0
	ISZ	EDITPG
	DCA	THISPG
	JMS I	[FORMFD	/OUTPUT A HEADING
	JMS I	SYMHND	/NOW READ THE SYMBOL TABLE SORT OVERLAY
	0200		/2 PAGES
SYMSRT,	OUDEVH+400	/TO HERE
	ASWAP+1		/FROM HERE
	JMP I	SYMERR	/UGH
	JMS I	SYMSRT	/SORT THEM AND SET LINK
SYMNWP,	DCA	SYMTAG	/POINT TO SYMBOL
	SZL		/LINK OFF IF ANY SYMBOLS TO LIST
	JMP I	SYMPRT	/NONE --RETURN--
	TAD	SMIN67	/SET LINE/PAGE COUNT
	DCA	SYMLCT
SYMPAG,	TAD	HIGHTG
	CLL CIA
	TAD	SYMTAG
	SZL CLA
	JMP I	SYMPRT	/NO MORE IF AT HIGHTAG NOW
	TAD	SYMTAG
	DCA	THISTG	/PREPARE TO PRINT LEFTMOST SYMBOL
	TAD	SYMNCL	/4 PER LINE (DEFAULT)
	DCA	SYMCCT	/TO COLLUMS/LINE CNTR
	JMP	SYMGO
SYMLIN,	JMS I	[ERROR1
	JMS I	[ERROR1
	JMS I	[ERROR1
	TAD	HIGHTG
	CLL CIA
	TAD	THISTG
	SZL CLA
	JMP	SYMNXL	/SKIP TO NEXT LINE IF OFF TABLE
SYMGO,	JMS I	[FINDTG	/OK, GET IT
	TAD	TAG1
	JMS I	SDIV45
	TAD	TAG2
	JMS I	SDIV45
	TAD	TAG3
	JMS I	SDIV45
	TAD	[240
	JMS I	OERROR
	TAD	VALUE2	/PRINT VALUE NOW
	JMS	OCTPRT
SYMDDT,	TAD	SMIN67
	CLL CIA
	TAD	THISTG
	DCA	THISTG
	SZL
	JMP	SYMNXL	/SKIP IF WRAP AROUND
	ISZ	SYMCCT	/ELSE DO NEXT COLUMN
	JMP	SYMLIN
SYMNXL,	TAD	[215
	JMS I	OERROR	/CR/LF
	ISZ	SYMTAG	/POINT TO NEXT SYMBOL
	ISZ	SYMLCT
	JMP	SYMPAG
HSWIT2,	JMS I	[FORMFD
	TAD	SYMTAG
	CLL
	TAD	SYMOFS	/OFFSET TO NEXT SYMBOL
	JMP	SYMNWP	/DO THE NEXT PAGE

SDIV45,	DIV45
SMIN67,	-67
SYMERR,	SYSERR
SYMHND,	7607
SYMOFS,	245		/DEFAULT
SYMNCL,	-4
	SYMTAG=	LINKSW
	SYMLCT=	UNDFSW
	SYMCCT=	ALPHAI
	ZBLOCK	4	/WASTE SOME SPACE
	>


/END OF AREA WHICH MAY BE SWAPPED OUT
/DURING PASSES 1 AND 2
/**********************************************************************

	ENDOVL=	.
/OCTAL PRINT ROUTINE
/ENTER WITH # TO BE OUTPUT IN AC
/** DO NOT USE TEMPS BELOW THIS LOC!

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--

/OUTPUT ONE REGISTER

PUNONE,	0
	TAD PASS	/WHICH PASS IS THIS?
	SNA
	JMP PUNON2	/PASS 2--OUTPUT BINARY
	SPA CLA
	JMP PUNON3	/PASS 1--EXIT
	TAD VALUEX	/THE BANK BIT IS

	CLL RTR		/ADJUSTED TO ASCII
	RAR
	TAD ["0
	JMS I OERROR	/THEN PRINTED
	TAD FLDIND	/GET FIELD NUMBER
	TAD ["0		/CONVERT TO ASCII
	JMS I OERROR	/PRINT IT
	TAD LOC		/GET LOW ORDER 4 DIGITS (LOC CTR)
	JMS OCTPRT	/PRINT IT TOO
	TAD OFFSET	/IF THIS CODE IS IN A RELOC SECTION,
	SZA CLA		/
	TAD [1200	/FLAG THE LOCATION COUNTER WITH A *
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 PUNON3	/AND EXIT

PUNON1,	TAD LINKSW	/NO LINE - OUTPUT LINK SWITCH ANYWAY
	SZA		/IF THERE IS ONE
	JMS I [ERROR1
	TAD [215	/OUTPUT CARRIAGE RETURN
	JMS I OERROR
PUNON3,	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 PUNON3	/AND EXIT
	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
	JMS I PPEZE	/GENERATE PE OR ZE ERROR
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 PUNMOD	/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--

PPEZE,	PEZE
HEADER,	"S;"Y;"M;"B;"O;"L;"S
	211;211;211;211;211	/FOR /N HEADER

/************************************************************
/CODE OVERLAYED ON PASS 3
/BY USER HEADER BUFFER

/CONTINUATION OF EXPUNGE HANDLER
/ENTER ON PASS 1 ONLY

EXPUNW,	IFZERO	HASH<
	DCA TEMP1
	DCA EXPUN2	/CLEAR NEW HIGH TAG COUNTER
	TAD HIGHTG
	CMA
	DCA TEMP3	/SAVE NUMBER OF SYM TBL ENTRIES
EXPUNY,	TAD TEMP1
	DCA THISTG
	JMS I [FINDTG	/GET A SYMBOL
	TAD TAG1	/ONLY SAVE THE SYMBOL IF
	RTL
	CLA		/IT WAS A PSEUDO-OP, OR
	TAD TAG3	/THE SYMBOLS I OR Z
	SNL SMA CLA
	JMP EXPUA4	/NO-FORGET TAG
	TAD EXPUN2	/YES-RETURN TAG TO SYMBOL TABLE
	DCA THISTG
	JMS I [PUTTAG
	ISZ EXPUN2
EXPUA4,	ISZ TEMP1
	ISZ TEMP3	/DONE YET?
	JMP EXPUNY	/NO- TRY NEXT TAG
	CLA CMA		/YES
	TAD EXPUN2	/RESET HIGH TAG
	DCA HIGHTG
	JMP I [LOOKEX	/--EXIT TO MAIN--

EXPUN2,	0
	>
	IFNZRO	HASH<
	/HASH TABLE EXPUNGE - DEPENDS ON PSEUDO OPS
	/BEING HASHED FIRST. SCANS WHOLE TABLE (SLOW AS HELL!)

	DCA	THISTG	/POINT TO FIRST ENTRY
	TAD	TAGMAX	/SET THE COUNT
	CIA
	DCA	TEMP1
EXPUNL,	JMS I	[FINDTG	/GO GET ONE
	TAD	TAG1	
	RTL
	CLA
	TAD	TAG3
	SPA SZL CLA	/PSEUDO OP?
	JMP	EXPUNS	/YES, SKIP DELETION
	DCA	TAG1	/NO, WIPE IT
	DCA	TAG2
	DCA	TAG3
	JMS I	[PUTTAG	/AND PUT IT BACK
	STA
	TAD	HIGHTG
	DCA	HIGHTG	/DECREMENT SYMBOL COUNT
EXPUNS,	ISZ	THISTG	/POINT TO NEXT ENTRY
	ISZ	TEMP1	/TALLY COUNT
	JMP	EXPUNL	/GET ANOTHER
	JMP I	[LOOKEX	/DONE --RETURN--
	>

/***************************************************************
/ASSEMBLER HEADER BUFFER

	ZBLOCK	HEADER+HEDLEN-.

	" ;" ;"P;"A;"L;"8;"-
	"V;"1;VERSION-12+"0;SUBVERSION
	" 
DATE,	"N;"O;" ;"D;"A;"T;"E;" 	/GETS SET TO DD-MMM-YY IF DATE PRESENT
	" ;" ;"P;"A;"G;"E;" ;0
/PUSHDOWN LIST
/OCCUPIES NEXT 43(8) LOCATIONS
PDLND=.



/*********************************************************
/ONCE ONLY CODE FOR /D OPTION
/PUT INTO SYMLST FOR DDT COMPATIBLE SYMBOL TABLE
/OVERLAYED DURING ASSEMBLY BY PUSHDOWN LIST

DSWIT1,	IFZERO	HASH<
	RELOC SYMPRT+4

	DCA I SYMPRF
	JMS SYMPRC
	TAD [377
	JMS I OERROR
	CLA CMA
	DCA THISTG
SYMPRE,	TAD [215
	JMS I OERROR
	JMS SYMPPP
	JMP SYMPRD
	JMP SYMPR1
SYMPRF,	HSWIT1
SYM204,	204
	RELOC

	>
	IFNZRO	HASH<
	RELOC	SYMNWP
	DCA	THISTG
	DCA I	SYMHSW
	JMS	DDTLDR
	TAD	[377
	JMS I	OERROR
SYMLUP,	TAD	[215
	JMS I	OERROR
	TAD	HIGHTG	
	CLL CIA
	TAD	THISTG
	SZL CLA
	JMP	SYMXIT
	JMP	SYMGO
SYMHSW,	HSWIT1
	RELOC
	>
DSWITA=	.

/**********************************************************
	PAGE
/*************************************************************

/PAL8 TABLES - LOAD OVER INITIALIZATION CODE

PDLST=	PDLND+42	/PUSHDOWN LIST 43(8) LOCS LONG


LINBUF=	PDLST+1		/LINE BUFFER OCCUPIES 122(8) LOCATIONS

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, SUBSCRIPTS 20-177

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

/*************************************************************
/ONCE ONLY CODE FOR ASSEMBLER START UP
/OVERLAYED BY BUFFERS

/HANDLES SWITCH OPTIONS

BEGIN,	CIF 10
	JMS I IOMON	/CALL USER SERVICE ROUTINES
	5		/*COMMAND DECODER*
	2001		/DEFAULT INPUT EXTENSION IS .PA
NOCD,	CDF 10		/RETURN
	TAD I (7604	/IS THERE A BINARY FILE EXTENSION?
	SNA
	TAD (216	/NO - DEFAULT EXTENSION IS .BN
	DCA I (7604	/YES 
	TAD I (7611	/IS THERE A LISTING FILE EXTENSION?
	SNA
	TAD (1423	/NO - DEFAULT EXTENSION IS .LS
	DCA I (7611
	TAD I (MPARAM+1	/WAS THE /T OPTION SELECTED?
	CDF
	AND (20
ZT7640,	SNA CLA
	JMP BEGINA	/NO
BEGIAA,	DCA I (HSWITC	/YES - GENERATE CR/LF IN PLACE OF F/F
	JMP BEGIN2

BEGINA,	TAD [7605	/WAS TTY THE PASS 3 DEVICE?
	JMS I (OTYPE
	AND (770
	SNA CLA
	JMP BEGIAA	/YES - GENERATE CR/LF IN PLACE OF F/F
	DCA I (BEGIAB	/NOT /T OR TTY:

BEGIN2,	CDF 10
	TAD I (MPARAM+1	/WAS THE /S OPTION SELECTED?
	CDF
	AND (40
	SZA CLA
	DCA I (SSWITC	/YES -OMIT SYMBOL TABLE
	CDF 10
	AC2000
	AND I (MPARAM+1
	CDF
	SNA CLA		/WAS THE /N OPTION SELECTED?
	JMP BEGIN4	/NO
	TAD BEGSKP	/SET SWITCH
	DCA I (NSWITC	/YES -SYMBOL TABLE BUT NO LISTING
BEGIN4,	CDF 10
	TAD I (MPARAM	/WAS THE /H OPTION SELECTED?
	CDF
	AND (20
ZH7640,	SNA CLA
	JMP BEGINB	/NO
BEGHSW,	TAD I (FORM21	/YES -SUPPRESS LISTING PAGE FORMAT
	DCA I (HSWITC
	DCA I (HSWIT1
BEGSKP,	CLA SKP
BEGINB,	DCA I (HSWIT2
	CDF 10
	TAD I (MPARAM	/WAS THE /D OPTION SELECTED?
	CDF
	AND [400
ZD7640,	SNA CLA
	JMP BEGIN1	/NO
	TAD I XREG1	/YES -DDT COMPATIBLE SYMBOL TABLE
	DCA I LAST3	/SUBSTITUTE ALTERNATE CODE
	ISZ DSWIT3	/INTO SYMBOL TABLE OUTPUT ROUTINE
	JMP .-3
	TAD I XREG2
	DCA I LAST4
	ISZ DSWIT4
	JMP .-3

BEGIN1,	TAD I (JSBITS	/RESET JOB STATUS WORD TO
	AND (6777	/INDICATE PAL8 NOT RESTARTABLE
	TAD (1000
	DCA I (JSBITS
	CIF CDF	10
	JMS I	(FMTDAT	/CALL ROUTINE IN FIELD 1 TO SETUP DATE
	JMP I	(BEGINZ	/CONTINUE ON

DSWIT3,	DSWIT1-DSWITA
DSWIT4,	DSWIT2-DSWITB
	PAGE
/ONCE ONLY CODE CONTINUED
/ASSEMBLER INITIALIZATION PROCEDURES


BEGINZ,	TAD [7600	/WHAT DEVICE FOR BINARY OUTPUT?
	JMS I (OTYPE
	SMA CLA
	TAD (-70	/STAND-ALONE
	TAD (-10	/DIRECTORY
	DCA I (SWAPR2+LEADER	/SET AMOUNT OF LEADER TRAILER
	DCA LAST1	/NO DEFINED TAG
BEGIN5,	IFZERO	HASH<
	CDF
	TAD I BLK1	/MOVE SYMBOL TABLE TO FIELD 1
	CDF 10
	DCA I BLK2
	ISZ BLK1
	ISZ BLK2
	ISZ BLK3
	JMP BEGIN5
	>
	CDF
	DCA I [LINBUF+120	/SET BUFFER POINTERS
	DCA I (LINBUF+121
	TAD [7600	/IS PTP BINARY OUTPUT DEVICE?
	JMS I (OTYPE
	DCA BLK1
	TAD BLK1
	AND (770
	TAD (-20
	SNA CLA
	DCA I (PTPSW	/YES - SET PTP SWITCH
	TAD BLK1	/NO - IS IT A DIRECTORY DEVICE?
	SPA CLA
	JMP .+3		/NO
	TAD (TAD [77	/YES - SET DIRECTORY SWITCH
	DCA I (DIRSW
	TAD [7605	/IS PTP GETTING LISTING OUTPUT?
	JMS I (OTYPE
	AND (770
	TAD (-20
	SNA CLA
	DCA I (SWAPR2+PTPSW1	/YES - SET PASS 3 PTP SWITCH
	TAD [7605	/NO - IS DIRECTORY DEVICE GETTING
	JMS I (OTYPE	/LISTING OUTPUT?
	SPA CLA
	JMP .+3		/NO
	TAD (TAD [77	/YES - SET PASS 3 DIRECTORY SWITCH
	DCA I (SWAPR2+DIRSW1
	JMP I (BEGINF
MONLST,	TEXT	/JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC/
	*.-1

/CONTINUED CHECK OF COMMAND DECODER OPTIONS

BEGINH,	CDF 10
	TAD I (MPARAM	/WAS THE /G OR /L OPTION CHOSEN?
	CDF
	AND (41
	SNA CLA
	JMP I (BEGISW	/NO
	CDF 10		/YES
	TAD I [7600
	SZA CLA		/WAS THERE A BINARY OUTPUT FILE?
	JMP YESBIN	/YES
BINLOP,	TAD PALBIN	/NO - CREATE FILE PAL8BN.TM
	DCA I PALBIX	/ON SYSTEM DEVICE
	ISZ BINLOP
	ISZ PALBIX
	ISZ BINCNT
	JMP BINLOP
	CDF
	TAD (-10	/SET AMOUNT OF LEADER TRAILER
	DCA I (SWAPR2+LEADER
/SET UP FOR LOAD OR LOAD AND GO

YESBIN,	CDF
	CIF 10
	CLA IAC
	JMS I IOMON	/CALL USER SERVICE ROUTINES
	2		/* LOOKUP PERMANENT FILE *
LOAD,	PLOAD		/FILENAME ABSLDR.SV
BINCNT,	-5		/FILE LENGTH
	JMP NOLOAD	/ABSLDR.SV NOT FOUND
	TAD LOAD	/NORMAL RETURN
	DCA I (CHAIN	/SET STARTING BLOCK NUMBER
	DCA I (LSWITC	/FOR CHAIN CALL
	JMP I (BEGISW

NOLOAD,	JMS I [ERROR	/GENERATE LD ERROR MESSAGE
	LD
	JMP I (BEGISW	/ASSEMBLE BUT DO NOT CHAIN TO LOADER

BLK1,	SYMS
BLK2,	7600+SYMS-SYME
BLK3,	SYMS-SYME

PALBIX,	7600
PALBIN,	1
	FILENAME PAL8BN.TM
	PAGE
CCC,	TAD I CC231	/FINAL PIECE OF STARTUP ONCE-ONLY CODE
	SNA
	TAD CC23
	DCA I CC231	/"HSWITC"=JMP FORMF1 IF WAS 0
BEGISW,	CDF 10
	TAD I CCJWD
	CDF 0
	AND CCJBIT
ZJ7640,	SNA CLA		/WAS /J OPTION SPECIFIED?
	DCA I CCJLOC	/NO - PRINT UNASSEMBLED CONDITIONAL CODE
	CDF 10
	TAD I CCWWD
	CDF 0
	AND CCWBIT
ZW7640,	SNA CLA		/WAS /W OPTION SPECIFIED?
	JMP D4		/V3C
D5,	TAD I CC231
	CIA
	TAD CC23
	SZA CLA		/ARE WE OUTPUTTING FF'S IN LISTING?
	JMP BEGIS3	/NO
	TAD CC24	/YES - SUBSTITUTE SOME CODE
	DCA I CC25
	TAD CC26
	DCA I CC27
	TAD CC24
	DCA I CC28
BEGIS3,	JMS I OVLL7	/CALL SYSTEM DEVICE
	4200		/WRITE 2 PAGES
	SWAP1		/FORM SWAP1
	ASWAP		/INTO TEMP AREA
	JMP I OVLL8	/ERROR?!
	TAD I LAST2	/MOVE PASS 1&2 ONLY CODE
	DCA I TAGXR	/OVER PASS3 SWAPPED OUT CODE
	ISZ CC29
	JMP	.-3
	IFNZRO	HASH<
	JMS I	CCHSH	/FINALLY HASH OUT THE TABLE
	>

	JMP I	.+1
	START2-1	/OK - NOW GO DO SOME ASSEMBLING!
D4,	DCA I CCWLOC	/NO - DON'T WIPE LITERALS AS YOU DUMP THEM
	DCA I (D3
	JMP D5		/V3C
OVLL7,	7607
OVLL8,	SYSER3

CC231,	HSWITC
CC23,	FORMF1&177+5200
CC24,	STA
CC25,	FORMF1
CC26,	DCA LINCNT
CC27,	FORMF1+1
CC28,	FORMF1+2
CC29,	SWAPB2-SWAPE2

	IFNZRO	HASH<
CCHSH,	HSHSMS
	>
CCJWD,	MPARAM
CCJBIT,	4
CCJLOC,	IFTST4
CCWWD,	MPARAM+1
CCWBIT,	2
CCWLOC,	LITHAK
PLOAD,	FILENAME ABSLDR.SV

CKBAT,	TAD I CC7777	/GET BATCH FLAG WORD
	CLL RTL
	SNL CLA		/BATCH RUNNING?
	JMP I CCOPTM	/NO, GO WITH LINK OFF
	TAD I CC7777
	AND CC0070	/GET BATCH FIELD
	TAD CCCIF0	/FORM CIF TO BATCH FIELD
	DCA OTYPB1	/MODIFY TTY OUTPUT ROUTINE TO GO TO BATCH
	TAD CCJMSB	/LOG INSTEAD
	DCA OTYPB2
	TAD OTYPTD
	DCA OTYPB3
	JMP I CCOPTM	/RETURN TO CORE DETERMINER, LINK SET

CC7777,	7777
CCOPTM,	OPTIM4
CC0070,	70
CCCIF0,	CIF 0
CCJMSB,	JMS I [BATOUT
/THIS CODE SITS AFTER THE END OF THE LITERAL TABLE

	IFNZRO	.-LITBF1-200&4000 <*LITBF1+200>

OTYPEO,	0		/TYPE A CHARACTER, CHECKING FOR ^O AND ^C
	DCA OTYPEC	/SAVE CHAR
	JMS CTCCHK	/CHECK FOR ^C - RETURN CHAR-203 IN AC
	TAD (-14
	SNA CLA		/^O?
	JMP I OTYPEO	/YES
OTYPTD,	TAD OTYPEC
OTYPB1,	TLS
OTYPB2,	TSF
OTYPB3,	JMP	.-1	/WAIT FOR TTY
	TAD	[-215
OTYPCR,	SZA CLA		/SET TO CLA DURING "ERRORS DETECTED" STUFF
	JMP I	OTYPEO
	TAD [212	/IF CHAR WAS CR, TYPE LF
	JMP OTYPEO+1
OTYPEC,	0

CTCCHK,	0		/CHECK FOR ^C
	TAD [200
	KRS		/OR IN KEYBOARD CHAR
	TAD (-203
	SNA
	KSF		/3B BUT WAS CHAR REALLY THERE?
	JMP I CTCCHK	/NO ^C - RETURN
	JMP I [7600	/RETURN TO OS/8

TTLMSG,	"E-240^100+"R-240	/ERRORS DETECTED:
	"R-240^100+"O-240
	"R-240^100+"S-240
	"D-240
	"E-240^100+"T-240
	"E-240^100+"C-240
	"T-240^100+"E-240
	"D-240^100+":-240
	0

	"L-240^100+"I-240	/LINKS GENERATED:
	"N-240^100+"K-240
	"S-240^100
	"G-240^100+"E-240
	"N-240^100+"E-240
	"R-240^100+"A-240
	"T-240^100+"E-240
	"D-240^100+":-240
	0
	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
	AND [200
	SNA CLA
	TAD OUTPT2	/IF LESS THAN 200, THEN
	TAD CHKSUM	/ADD IT TO CHECKSUM
	DCA CHKSUM
	TAD OUTPT2	/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
/PACKS CHARACTERS IN STANDARD OS/8 FORMAT

OUTPUX,	0
	ISZ OUJMP	/BUMP 3-WAY SWITCH
OUJMP,	HLT		/WILL BE CHANGED - SHOULD NEVER HALT
	JMP OCHAR1	/CHARACTER #1
	JMP OCHAR2	/CHARACTER #2
OCHAR3,	TAD OUTPT2	/CHARACTER #3
	CLL RTL
	RTL
	AND [7400
	TAD I OUPOLD	/ADD 4 BITS TO WORD 1
	DCA I OUPOLD
	TAD OUTPT2
	CLL RTR
	RTR
	RAR
	AND [7400
	TAD I OUPTR	/ADD 4 BITS TO WORD 2
	DCA I OUPTR
	TAD OUJMPE
	DCA OUJMP	/RESET SWITCH
	ISZ OUPTR
	ISZ OUDWCT	/BUFFER FULL?
	JMP OUCHLV	/NO
	TAD [200	/YES
	JMS I (OUTDMP	/DUMP BUFFER
	JMS OUSETP	/RESET POINTERS
	JMP OUCHLV

OCHAR2,	TAD OUPTR	/SAVE POINTER
	DCA OUPOLD
	ISZ OUPTR
OCHAR1,	TAD OUTPT2
	DCA I OUPTR	/SET 8 BIT WORD
OUCHLV,	TAD OUTPT2
/	TAD [40
/	AND [100	/CHECK FOR PRINTABLE CHAR
/	SZA CLA		/IF IT IS,
	TAD [-240
	SMA CLA
	ISZ LSTCNT	/BUMP TAB COUNT
OUTINH,	0		/ALWAYS 0 OR 1!
	JMP I OUTPUX	/--RETURN--

OUPOLD,	0
OUPTR,	0
OUJMPE,	JMP OUJMP
OUDWCT,	0
OUTPT2,	0

OUSETP,	0
	TAD [7600	/SET OUTPUT WORD COUNT
	DCA OUDWCT	/TO 200
	TAD (OUBUF
	DCA OUPTR	/RESET POINTER
	TAD OUJMPE
	DCA OUJMP	/RESET SWITCH
	CLL		/MUST CLEAR LINK!!
	JMP I OUSETP	/--RETURN--
/HANDLER FOR DEVICE PSEUDO-OP

DEVICX,	JMS I [SPNOR	/IGNORE TRAILING SPACES
	TAD [-5
	JMP DEVIC1	/PACK 4 CHARACTERS


/HANDLER FOR FILENAME PSEUDO-OP

FILENX,	JMS I [SPNOR	/IGNORE TRAILING SPACES
	TAD (-7
	JMS FILE1	/PACK 6 CHARACTERS
	TAD CHAR
	TAD [-".	/WAS CHARACTER . ?
	SNA CLA
	JMS I [GETC	/YES-SKIP TO EXTENSION
	AC7775
DEVIC1,	JMS FILE1	/PACK 2 CHARACTERS
	JMP I [LOOKEX	/--EXIT TO MAIN--

/PACK CHARACTERS
/NEGATIVE OF # OF CHARACTERS TO BE PACKED IN AC ON ENTRY

FILE1,	0
	DCA FILE6	/SAVE # OF CHARACTERS TO PACK
	DCA I (TEXT6	/RESET PACK SWITCH
FILE4,	JMS I (TSTALN	/IS CHARACTER IN CHAR ALPHANUMERIC?
	SKP
	JMP FILE5	/NO-DONE PACKING
	ISZ FILE6	/YES-TOO MANY CHARACTERS?
	JMP FILE3	/NO-O.K.
	CLA CMA	/YES
	DCA FILE6	/RESET # OF CHARACTERS AND IGNORE
	JMP FILE2

FILE3,	TAD CHAR
	JMS I (TEXT2	/PACK A CHARACTER
FILE2,	JMS I [GETC	/GET A CHARACTER
	JMP FILE4	/TEST IT

	JMS I (TEXT2	/PACK A ZERO CHAR
FILE5,	ISZ FILE6	/ARE WE DONE?
	JMP .-2		/NO - PAD WITH ZEROES
	JMP I FILE1	/YES--RETURN--
FILE6,	0
	PAGE
/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

TEXT8,	JMS I [GETC	/GET NEXT CHARACTER
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 GETCI TO CALL ; AND / END OF LINE
	JMS I [GETC	/SKIP DELIMITER
TEXT4X,	JMS TEXT2	/OUTPUT 0 TO FILE
	JMS TEXT2
/CHANGE TEXT4X TO:
/	NOP
/FOR NO EXTRA WORD OF ZEROS
	DCA GETCI	/RESET GETCI IN CASE WE HIT CR
	JMP I [LOOKEX	/--EXIT TO MAIN--
TEXT9,	JMS I [ERROR	/GENERATE IC ERROR MESSAGE
	IC
	JMP TEXT3

/SKIP ON PRINTING CHARACTER

TEXT1A,	0
	TAD CHAR
	SPA SNA CLA	/IS CHARACTER -
	JMP TEXT4X	/YES
	TAD CHAR
	TAD [40
	AND [100
	SZA CLA		/IS THE CHAR 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



/CLOSE OUTPUT FILE

OCLOSE,	0
	TAD I (OUTINH	/OUTPUT INHIBITED?
	SZA CLA
	JMP I OCLOSE	/YES--RETURN--
PTPSW,	TAD [232	/NO-0 IF PTP: - OUTPUT ^Z
	JMS I OCHAR
	JMS I OCHAR	/AND ZEROS
FILLLP,	JMS I OCHAR
DIRSW,	TAD [177	/TAD [77 IF NOT DIRECTORY
	AND I (OUDWCT	/FILL OUT BUFFER OR HALF BUFFER
	SZA CLA		/WITH ZEROS
	JMP FILLLP
	TAD I (OUDWCT	/IS THERE OUTPUT TO BE DUMPED?
	TAD [200
	SZA
	JMS OUTDMP	/YES - DUMP IT
	TAD OUFILE	/GET DEVICE NUMBER IN AC
	CIF 10
	JMS I IOMON	/CALL USER SERVICE ROUTINES
	4		/*CLOSE OUTPUT FILE*
OUCNAM,	0		/POINTER TO FILENAME TO BE DELETED
OUCCNT,	0		/LENGTH OF NEW PERMANENT FILE
	JMP SYSER3	/DE**FATAL ERROR**
	JMP I OCLOSE	/--RETURN--

OUFILE,	ZBLOCK 5
/OUTPUT DUMP
/AC CONTAINS CONTROL WORD FOR DUMP

OUTDMP,	0
	TAD [4000	/BE SURE CONTROL WORD IS
	DCA OUCTLW	/A WRITE OPERATION
	TAD OUBLK	/GET STARTING BLOCK NUMBER
	TAD OUCCNT	/ADD IN COUNT
	DCA OUREC	/SET THIS BLOCK NUMBER
	TAD OUCTLW
	TAD [100	/ROUND HALF-BLOCK, IF ANY
	CLL RTL
	RTL
	RTL
	AND [17		/GET THIS COUNT
	TAD OUCCNT
	DCA OUCCNT	/ADD TO TOTAL COUNT
	TAD OUCCNT	/IS OUTPUT DEVICE FULL?
	CLL CML
	TAD OUELEN	/CHECK AGAINST MAXIMUM LENGTH
	SNL SZA CLA
	JMP SYSER2	/DF**FATAL ERROR**
	JMS I OUHNDL	/CALL OUTPUT DEVICE HANDLER
OUCTLW,	0		/CONTROL WORD
	OUBUF		/BEGINNING OF OUTPUT BUFFER
OUREC,	0		/STARTING BLOCK NUMBER
SYSER3,	CLA SKP		/ERROR RETURN
	JMP I OUTDMP	/--RETURN--
SYSERR,	TAD (DE		/DE **FATAL ERROR**
	JMP I [MONERR

OUHNDL,	0
OUBLK,	0
OUELEN,	0

SYSER2,	TAD (DF		/GENERATE DF ERROR MESSAGE
	JMP I [MONERR	/**FATAL ERROR**
	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,	JMS I (CTCCHK	/CHECK FOR ^C
	CLA		/** CTCCHK RETURNS AC NON-ZERO!
	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
STAR0,	DCA STARSW	/ENTER HERE FROM RELOC WITH AC = -1
	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 STAR2	/YES-PUNCH ORIGIN
	JMS I [DUMPS	/NO-DUMP LITERALS
	TAD OFSBUF	/SET OFFSET TO NEW VALUE
	DCA OFFSET	/AFTER LITERALS ARE DUMPED.
	TAD OP		/PUNCH NEW ORIGIN, SET "VALUE"
	JMP I (STAR3	/FOR LISTING, AND SET UP IN NEW PAGE

STAR2,	TAD OFSBUF	/SET OFFSET TO NEW VALUE
	DCA OFFSET	/
	TAD OP
	JMS I [PUNORG	/PUNCH ORIGIN
	DCA LAST1	/CLEAR LAST DEFINED SYMBOL
	JMP I [PUNVAL

ALPHA,	JMS I [GETTAG	/PICK UP TAG-IS IT IN TABLE?
	DCA ALPHAI	/STORE 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
	AC4000		/NO
	JMP TOEXP	/TREAT AS AN EXPRESSION
/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--
OPTABL,	OP0		/+
	OP1		/-
	OP6		/%
	OP2		/&
	OP5		/(SPACE)
OPEXPL,	OP5		/! - CHANGED TO OP3 IF /B ON
	OP4		/^
XCHANG,	0
	TAD VALUE
	AND [30
	SNA
	JMP .+3
	TAD [7700
	JMS I OCHAR
	JMP I XCHANG
	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 (-"+
	CLL RTR		/PUT THE 2 BIT IN THE LINK
	SZA CLA		/WAS CHAR 53(+) OR 55(-)?
	JMP EXP1A	/NO
	RAL		/YES - OP IS 0 OR 1, DEPENDING
EXP1,	DCA OP
	JMS I [GETC	/GET NEXT CHARACTER
	ISZ EXPIND	/MRI NO LONGER LEGAL ON THIS LINE
EXP1A,	TAD CHAR	/IS CHARACTER A . ?
	TAD [-".
	SNA
	JMP PERIOD	/YES-GO TO . HANDLER
	TAD (".-""	/NO-IS IT " ?
	SNA
	JMP QUOTE	/YES-GO TO " HANDLER
	TAD (""-"[	/NO-IS IT [ ?
	CLL
	SZA
	TAD ("[-"(	/OR (?
	SNA CLA
	JMP I (LIT	/YES - LITERAL - LINK HOLDS WHICH KIND
	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 EXP1A	/NOGO - TRY AGAIN
	TAD OP
	TAD [-4		/IS OP SPACE (4)
	SNA CLA
	JMP I (EXPXIT	/YES-EXIT
	JMS I [ERROR
	IC		/GIVE IC MESSAGE ON ILLEGAL OPERATOR
	JMP I (EXPINT	/EXIT ANYWAY
/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 [ICMESG	/NO - GENERATE IC MESSAGE AND GET NEXT CHAR
	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?
	AND TEMP	/NO
	TAD TEMP2	/YES
	CLL RAL
	TAD CHAR
	TAD (-"0
	DCA TEMP
	JMS I [GETC	/GET NEXT CHARACTER
NUMBE4,	JMS I [TSTNUM	/IS IT NUMERIC?
	JMP NUMBE2	/YES-CONTINUE ACCUMULATING NUMBER
	TAD TEMP	/NO-STORE NUMBER
NUMBE1,	DCA VALUE2
NUMBE5,	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 [ICMESG	/GENERATE IC ERROR MESSAGE AND
	JMP NUMBE4	/IGNORE CHARACTER


/HANDLER FOR .

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

/HANDLER FOR "

QUOTE,	ISZ TXTPTR
	TAD I TXTPTR	/GET CHARACTER FROM TEXT BUFFER
	TAD [-215	/WAS IT CARRIAGE RETURN?
	SNA CLA
	JMP 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 NUMBE5	/RETURN TO EXPRESSION PROCESSOR

/CARRIAGE RETURN FOUND IN SINGLE CHARACTER TEXT

QUOTE1,	JMS I [ERROR	/GENERATE IC ERROR MESSAGE
	IC
	CLA CMA
	DCA CHAR
	JMP I (EXPXIT
	PAGE
/COME HERE IF FIRST THING IN EXPRESSION IS ALPHA CHARACTER

ALPHA1,	JMS I [GETTAG	/PICK UP TAG
	DCA ALPHAI	/STORE UNDEFINED INDICATOR
ALPHA3,	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 ALPHA0
	ISZ UNDFSW	/YES-SET UNDEFINED SWITCH
	TAD PASS	/IS THIS PASS 1?
	SPA CLA
	JMP ALPHA0	/YES-SUPPRESS ERROR MAESSAGE
	JMS I [ERROR	/NO-GENERATE US ERROR MESSAGE
	US
ALPHA0,	TAD TAG2	/NO-WAS IT A MEMORY REFERENCE INSTRUCTION?
	SPA CLA
	TAD CHAR	/YES-GET TERMINATING CHARACTER
	TAD [-240	/WAS IT SPACE?
	SZA CLA
	JMP I (NUMBE5	/NOT MEMREF FOLLOWED BY SPACE
	JMS I [SPNOR	/YES-IGNORE SPACES
	TAD CHAR
	SPA CLA
	JMP I (NUMBE5
	TAD EXPIND	/IS MEMORY REFERENCE INSTRUCTION OK?
	SZA CLA
	JMP I (NUMBE5	/NO-
	DCA IZIND	/YES-CLEAR I AND Z INDICATOR
	TAD VALUE2	/STORE MRI ON PUSHDOWN LIST
	JMS I [PUSHA
ALPHA6,	TAD IZIND
	JMS I [PUSHA	/PUSH THE I AND Z INDICATOR
	JMS I [TSTALP	/WAS TERMINATING CHARACTER ALPHABETIC?
	SKP
	JMP ALPHA4	/NO-
	JMS I [GETTAG	/YES-PICK UP TAG
	DCA ALPHAI	/STORE UNDEFINED INDICATOR
	AC2000
	AND TAG1	/WAS IT AN I OR Z?
	SNA CLA
	JMP ALPHA5	/NO
	TAD VALUE2	/YES-WAS IT I?
	SNA
	IAC		/NO - SET LOW ORDER
	TAD I	PDLXR	/GET OLD IZIND FROM PDL
	DCA IZIND	/SET NEW IZIND
	JMS I [SPNOR	/IGNORE SPACES
	JMP ALPHA6

EXPINT,	TAD EXPIND
	TAD [4000
	DCA EXPIND
	JMP ALPHA3

ALPHA5,	AC4000
ALPHA4,	IAC
	JMS I [EXP	/GET REST OF EXPRESSION
	TAD I PDLXR	/RETRIEVE MRI
	DCA IZIND
	TAD I PDLXR
	DCA VALUE2
			/FALL INTO NEXT PAGE
/COMBINE ADDRESS WITH MEMORY REFERENCE INSTRUCTION

	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 FIXMD0	/SET ' IN LISTING
	DCA LININD
	ISZ LINK	/BUMP NUMBER OF LINKS GENERATED
FIXMD0,	0700		/PROTECTION FOR ISZ
LGERR,	SKP		/JMS I PERROR IF /E SPECIFIED
	LG
	JMS ADDIND	/SET INDIRECT BIT IN INSTRUCTION
FIX2,	TAD [200	/SET CURRENT PAGE BIT
	TAD VALUE2
	DCA VALUE2
	TAD IZIND
	AND [77		/WAS Z SPECIFIED?
	SNA CLA
	JMP FIX4	/NO
	JMS I [ERROR	/YES - ILLEGAL REFERENCE
	IZ		/TO PAGE 0
FIX4,	TAD IZIND	/WAS THERE AN I?
	AND [7700
	SZA CLA
	JMS ADDIND	/YES - ADD INDIRECT BIT TO INSTRUCTION
	TAD VALUE	/GET ADDRESS
	AND [177
	TAD VALUE2	/GET OP CODE
	DCA VALUE	/STORE
POPJ,	TAD I PDLXR
	DCA TEMP	/POP A WORD OFF THE STACK
	JMP I TEMP	/JUMP THROUGH IT.
ADDIND,	0		/ROUTINE TO ADD INDIRECT BIT TO AN INSTR
	TAD VALUE2
	CMA
	AND [400
	SZA		/WAS THERE ONE ALREADY?
	JMP .+3	/NO
	JMS I [ERROR	/YES - ILLEGAL INDIRECT
	II
	TAD VALUE2
	DCA VALUE2
	JMP I ADDIND

/	ALLOWS MULTIPLE NON-RESIDENT INPUT HANDLERS TO NOT BOMB

PTCH,	0		/RUNS IN DF 10
	TAD (7647	/POINT TO DEVICE
	DCA PTR		/HANDLER RESIDENCY TABLE
	TAD [-17	/IT HAS 15 ENTRIES
	DCA KNTR	/V3C
KLOOP,	TAD I PTR	/GET HANDLER ENTRY POINT
	AND [7600	/LOOK AT PAGE IT'S ON
	TAD [-INDEVH	/IS IT ON THE PAGE WE PUT BUFFER OVER?
	SNA CLA		/WELL?
	DCA I PTR	/YES IT IS, WIPE IT FROM RESIDENCY
	ISZ PTR		/LOOK AT NEXT ENTRY
	ISZ KNTR	/ANY MORE ENTRIES?
	JMP KLOOP	/YES, MIGHT HAVE TO WIPE SEVERAL GUYS
	TAD [200	/INCREASE INPUT BUFFER SIZE
	JMP I PTCH	/V3C
	PAGE
/COMBINE CURRENT VALUE WITH PREVIOUS VALUE
/ACCORDING TO LAST OPERATOR

OP0,	TAD VALUE2	/HANDLER FOR +
	TAD VALUE	/** OP0+1 AND OP0+2 JUMPED TO **
	DCA VALUE
EXP3,	TAD CHAR	/GET LAST OPERATOR
	TAD (-"+	/WAS IT A + OR - ?
	CLL RTR
	SNA
	JMP PLSMIN	/YES - LINK=0 FOR +, 1 FOR -
	RTL
	TAD ("+-"%
	CLL RAR
	SNA		/IS THE CHAR % OR &?
	JMP DIVAND	/YES - LINK=0 FOR %, 1 FOR &
	RAL
	TAD ("%-240
	CLL RAR
	SNA		/IS THE CHAR SPACE OR !?
	JMP BLKEXP	/YES - LINK=0 FOR SPACE, 1 FOR !
	RAL
	TAD (240-"^
	SNA CLA		/IS THE CHAR ^?
	JMP MUL		/YES - LINK IRRELEVANT
	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--
MUL,	CLL IAC		/LINK DOESN'T COUNT FOR ^
BLKEXP,	IAC		/** BLANK ASSUMED TO BE 4 ELSEWHERE **
DIVAND,	IAC
PLSMIN,	RAL
	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

OP1,	TAD VALUE2	/- OPERATOR
	CIA
	JMP I (OP0+1	/JUMP INTO ADD OPERATOR

/OPTIONAL HANDLER FOR ! AS 6 BIT LEFT SHIFT AND THEN OR:

OP3,	TAD VALUE
	JMS I [RTL6
	AND [7700	/ISOLATE 6 BITS AND FALL INTO "OR"
	DCA VALUE	/V3C

/HANDLER FOR ! AND SPACE AS INCLUSIVE OR

OP5,	TAD VALUE
	CMA
	AND VALUE2
	JMP I (OP0+1
/CHARACTER INPUT CHECK
/ENTER WITH CHARACTER IN AC

LSTCH9,	SZA		/IGNORE NULL (0)
	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 (ENDCHR	/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
	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,	-HEDLEN
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
	PAGE
/ERROR MESSAGE OUTPUT

DUMPS1,
ERROR,	0
	CLA
	ISZ ERCNT	/COUNT THE ERRORS
ERPLUS,	"+		/PROTECTION
	TAD I ERROR	/GET ERROR MESSAGE
	ISZ ERROR	/INCREMENT RETURN ADDRESS
	JMS I [ERROR1	/OUTPUT 2 CHARACTER ERROR MESSAGE
	TAD (JMP I [7600 /PUT EXIT TO MONITOR
CSWIT1,	DCA I (LSWITC	/IN SWITCH - "CLA" IF /C
	TAD PASS	/IS THIS PASS 3?
	SMA SZA CLA
	JMP ERROR4	/YES - CARRIAGE RETURN/LINE FEED
	JMS I [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
	TAD LAST2	/OUTPUT SECOND 2 CHARACTERS
	JMS I (DIV45
	TAD LAST3
	JMS I (DIV45	/OUTPUT THIRD 2 CHARACTERS
	TAD LAST4	/IS ERROR LOCATION SAME AS LAST TAG?
	CIA
	TAD LOC
	SNA CLA
	JMP ERROR4	/YES - CARRIAGE RETURN
	TAD ERPLUS
	JMS I OERROR
	TAD LAST4
	CIA
ERROR3,	TAD LOC		/OUTPUT 4 DIGIT ADDRESS OR INCREMENT
	JMS I (OCTPRT
ERROR4,	TAD [215	/OUTPUT CARRIAGE RETURN/LINE FEED
	JMS I OERROR
	JMP I ERROR	/--RETURN--
/RESET LITERAL TABLES AND POINTERS

DUMPS5,
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
	SNA		/IF THIS IS PAGE 0,
	JMP I DUMPS	/--RETURN--
	TAD [LITBUF
	DCA DUMPS1
	TAD LITPTR
	CIA CLL
	TAD I DUMPS1
	DCA DUMPS2	/STORE NUMBER OF LITERALS ON THIS PAGE
	SZL		/ARE THERE ANY?
	JMP D2		/V3C
	DCA STARSW	/FORCE ORIGIN PUNCH IF RELOC JUST INVOKED
	TAD LOC
	AND [7600
	TAD I DUMPS1
	JMS I [PUNORG	/OUTPUT ORIGIN
	TAD I DUMPS1
	TAD (LITBF1
DUMPS3,	DCA DUMPS5
	TAD I [LINBUF	/SAVE LINBUF
	JMS I [PUSHA
	DCA I [LINBUF
DUMPS6,	TAD I DUMPS5
	DCA VALUE
JMSPUN,	JMS I [PUNONE	/OUTPUT ONE REGISTER
	ISZ LOC
	ISZ DUMPS5
LITHAK,	ISZ I DUMPS1	/DESTROY RECORD OF CURRENT PAGE LITERALS -
			/ZEROED IF NO /W OPTION SPECIFIED
	ISZ DUMPS2
	JMP DUMPS6
	TAD I PDLXR
	DCA I [LINBUF	/RESTORE LINBUF
D2,	TAD DUMPS1	/WIPE REMEMBRANCE OF TOP OF PAGE (JR)
	TAD (40		/V3C
	DCA DUMPS5
D3,	DCA I DUMPS5
	JMP I DUMPS	/--RETURN--
/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
	CMA		/PROTECT AGAINST ZERO CASE
	DCA TEMP3	/STORE NEGATIVE AS COUNTER
	JMP ZBLOCZ	/JUMP INTO LOOP
ZBLOCY,	JMS I [PUNBIN	/OUTPUT ONE WORD OF ZERO
	TAD PASS	/IS THIS PASS 3?
	SMA SZA CLA
	DCA I (PUNMOD	/YES - PREVENT OUTPUT
ZBLOCZ,	ISZ TEMP3	/NO - DONE YET?
	JMP ZBLOCY	/NO - CONTINUE
	TAD JMSPUN	/YES - RESTORE PUNMOD
	DCA I (PUNMOD
	JMP I [LOOKEX	/--EXIT TO MAIN--

/DUMP PAGE 0 LITERALS

DUMPS2,
DUMPZ,	0
	TAD DUMPZ	/RESET EXIT FROM DUMPS
	DCA DUMPS
	TAD [200
	CIA CLL
	TAD I [LITBUF	/STORE THE NUMBER OF LITERALS ON PAGE 0
	DCA DUMPS2
	SZL		/ARE THERE ANY?
	JMP I DUMPS	/NO - ** DUMPZ IS DESTROYED **
	TAD I [LITBUF
	JMS I [PUNORG	/OUTPUT ORIGIN
	TAD I [LITBUF	/SET VALUES FOR DUMPS
	TAD (LITBF2
	JMP DUMPS3
	PAGE
/ENTER A TAG INTO SYMBOL TABLE

	IFZERO	HASH<
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
	JMP I (SYMOFL	/NO - SE**FATAL ERROR**
	TAD TAGMAX	/YES - IS USR IN CORE?
	TAD (-1340
	SZL CLA
	JMP GETTG5	/YES
	TAD [7700	/NO - RESET ADDRESS TO
	DCA IOMON	/USR NON-RESIDENT
	AC7776
	AND I (JSBITS	/RESET JOB STATUS WORD TO
	DCA I (JSBITS	/SAVE CORE WHEN USR CALLED
GETTG5,	TAD THISTG	/SEARCH SYMBOL TABLE
	DCA TEMP2
	TAD HIGHTG
	IAC
	DCA THISTG
GETTG8,	AC7776
	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,	1740		/12K=3740, ...
	>

/	IFNZRO	HASH<	/***HACK ONLY***
/TLYREF,	0		/TALLY REFS TO SYMBOL TABLE
/	ISZ	NREFL
/	JMP I	TLYREF
/	ISZ	NREFH
/	JMP I	TLYREF
/	JMP I	TLYREF
/TLYPRB,	0		/TALLY PROBES INTO TABLE
/	JMS I	[FINDTG	/FUDGE, OUT OF ROOM
/	ISZ	NPROBL
/	JMP I	TLYPRB
/	ISZ	NPROBH
/	JMP I	TLYPRB
/	JMP I	TLYPRB
/NREFH,	0
/NREFL,	0
/NPROBH,	0
/NPROBL,	0
/	>		/***HACK ONLY***
	IFNZRO	HASH<

	/INSERT A TAG INTO THE HASH TABLE

INSRTG,	0
	ISZ	HIGHTG	/BUMP SYM NUM (SKIPS ON 0)
	TAD	HIGHTG
	STL CMA
	TAD	TAGMAX
	SNA SZL CLA	/STILL ROOM FOR AT LEAST 2 MORE?
	JMP I	(SYMOFL	/NO SE** FATAL ERROR**
	TAD I	(NAME1
	DCA	TAG1
	TAD I	(NAME2
	DCA	TAG2
	TAD I	(NAME3
	DCA	TAG3
	JMS I	[PUTTAG	/NOW ACTUALLY INSERT IT
	JMP I	INSRTG
	>
/OUTPUT 2 CHARACTER WORD
/FROM SYMBOL TABLE FORMAT
/DIVIDE BY 45(8)

DIV45,	0
	RAL
	CLL RAR		/CLEAR SIGN BIT
DIV45A,	ISZ DIV45C
	TAD (-45
	SMA
	JMP DIV45A
	TAD (45
	JMS DIV45E
	DCA DIV45B
	STA
	TAD DIV45C
	JMS DIV45E
	JMS I [RTL6
	TAD DIV45B
	JMS I [ERROR1	/OUTPUT 2 CHARACTERS
	DCA DIV45C	/CLEAR DIV45C FOR NEXT GO-ROUND
	JMP I DIV45	/--RETURN--

DIV45B,	0
DIV45C,	0		/** MUST BE 0 WHEN DIV45 IS ENTERED **

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

/SET FIELD

SETFLD,	0
	CLA CLL		/SETFLD CALLED WITH AC RANDOM
	DCA SETFL1	/INITIALIZE FIELD
	IFNZRO	HASH<
	TAD	USROFS	/FUDGE FOR KEEPING USR AROUND
	>
	TAD THISTG
SETFLP,	ISZ SETFL1
	CML
	TAD (-1740	/PUT 1740 SYMBOLS IN EACH FIELD
	SNL		/IS THE DIVIDE THROUGH?
	JMP SETFLP	/NO - CONTINUE
	IFZERO	HASH<
	CLL CMA RTL	/AC CONTAINED REM-1740; THIS MAKES IT INTO
	TAD (-1		/7573-4*REM WHICH IS THE ADDRESS WE WANT
	>
	IFNZRO	HASH<
	CLL RTL		/AC GETS 0201 TO 7775
	TAD	(-202	/AC GETS 7777 TO 7573 FOR TAGXR
	>
	DCA TAGXR	/TO STICK INTO AN AUTO-XR
	TAD SETFL1
	CLL RTL
	RAL
	TAD SETFL2
	DCA SETFL1
SETFL1,	HLT
	JMP I SETFLD	/--RETURN--
	IFNZRO	HASH<
USROFS,	0		/GETS 400 IF KEEPING USR
	>
/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
	PAGE
/BEGINNING OF PASS CODE

	JMS I (IOPEN	/SET INPUT ROUTINE TO OPEN FILE
START2,	ISZ PASS	/SET UP COUNTERS AND POINTERS
	DCA XLISTX	/CLEAR XLIST SWITCH
	DCA FLDIND	/SET FIELD TO 0
	DCA VALUEX	/SET BANK TO ZERO(128K)
	DCA CONDSW
	DCA EDITPG
	DCA LINK
	DCA RADIX
	DCA ERCNT
	DCA GETCI
	DCA PUNCHX
	DCA I [LINBUF
	TAD (PDLST
	DCA PDLXR
	JMS I [CLEAN
	TAD [200
	DCA LITPTR
	TAD [200
	JMS I [PUNORG
	JMP I (LOOKE1	/--EXIT TO MAIN--

/HANDLER FOR $

ENDPAS,	JMS I [DUMPS	/DUMP CURRENT PAGE LITERALS
	DCA OFSBUF	/CLEAR OFFSET FOR NEXT PASS
	TAD PASS	/WHAT PASS IS ENDING?
	SNA
	JMP I (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
ERMSGS,	TAD ERCNT
	JMS OUTTTL	/PRINT "ERRORS DETECTED: N"
	TAD LINK
	JMS OUTTTL	/PRINT "LINKS GENERATED: N"
FINLFF,	JMS I [FORMFD	/PRINT FINAL FF (ZEROED IF NO PASS 3)
	JMS I (OCLOSE	/AND CLOSE THE OUTPUT FILE
/CREF AND LOAD-AND-GO OPTIONS
/****FINAL EXIT TO MONITOR****
LSWITC,	JMP I [7605	/0 IF /L OR /G OR /C
	TAD (7616
	DCA XREG1
	CDF 10
CSWITC,	TAD I [7600	/"TAD I [7605" IF /C
	AND [17
	DCA I XREG1	/SET BINARY DEVICE
	TAD BINSRT

/EXIT FROM PAL8 BY CHAINING
/TO NEXT PROGRAM
/SHOULD BE ABSLDR OR CREF

	DCA I XREG1	/SET STARTING BLOCK
	DCA I XREG1	/SET 0 TERMINATOR
	CDF
	TAD I (JSBITS	/SET BIT 11 OF JOB STATUS WORD
	RAR		/SO 10000-11777 IS NOT SAVED
	CLL CML RAL
	DCA I (JSBITS
	CIF 10
	JMS I IOMON	/CALL USER SERVICE ROUTINES
	6		/*CHAIN TO NEXT PROGRAM*
CHAIN,	0		/STARTING BLOCK OF NEXT PROGRAM

OUTTTL,	0
	DCA LAST1	/SAVE NUMBER TO BE PRINTED
OUTTLL,	TAD I TTLPTR	/GET A WORD OF MESSAGE
	ISZ TTLPTR
	SNA		/END?
	JMP PRTTTL	/YES
	JMS I [ERROR1	/NO - PRINT IT
	JMP OUTTLL	/AND LOOP
PRTTTL,	TAD [240	/PRINT A SPACE
	JMS I OCHAR
	TAD LAST1
	JMS I (FORMF4	/PRINT NUMBER IN DECIMAL
	JMS I (CRLF	/PRINT CR AND 2 LF'S (1 IF PASS 3)
	JMP I OUTTTL	/AND RETURN

TTLPTR,	TTLMSG
/COME HERE TO LOAD THE PASS 3 OVERLAY AT THE END OF PASS 2

LOADOV,	JMS I (7607	/CALL SYSTEM DEVICE HANDLER
	0200		/SWAP IN CODE UNIQUE TO PASS 3
	SWAP1		/BUFFER ADDRESS
	ASWAP		/STARTING BLOCK NUMBER
	JMP I (SYSER3	/DE**FATAL ERROR**
NSWITC,	JMP START2	/(0 IF NO LIST FILE, SKP IF /N) START PASS3
	JMP ERMSG1
	JMP ENDPA1

ERMSG1,	TAD (OTYPEO	/COME HERE IF NO PASS 3 OUTPUT FILE
	DCA OCHAR
	TAD (OTYPEO
	DCA OERROR
	TAD [7600
	DCA I (OTYPCR	/INHIBIT AUTO-LF ON CARRIAGE RETURN
	DCA FINLFF	/KILL LAST FORM FEED
	JMP ERMSGS

/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
	TAD OFFSET	/"LOC" MAY BE FICTITIOUS - MAKE IT REAL
	CLL CML
	ISZ STARSW	/INHIBIT PUNCHING ORIGIN IF NECESSARY
	JMS I [PUNOUT
	CLA
	DCA STARSW	/RESET SWITCH
	JMP I PUNORG	/--RETURN--
	PAGE
/EVALUATE LITERAL

LIT,	STA RAL		/-2 IF PAGE 0 LITERAL, -1 IF CUR PAGE
	DCA FINDS1	/SAVE FLAG
	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 FINDS1
	JMS I [PUSHA
	JMS I [EXP	/GET EXPRESSION
	TAD VALUE	/FIND LITERAL IN TABLE
	ISZ I PDLXR	/PAGE 0?
	JMP .+3
	JMS FINDS	/NO
	SKP
	JMS FIND0	/YES
	DCA VALUE2	/STORE ADDRESS
	TAD I PDLXR
	DCA VALUE
	TAD I PDLXR	/RESTORE SAVED VALUES
	DCA OP
	TAD I PDLXR
	DCA EXPIND
	TAD CHAR	/IGNORE ) OR ]
	TAD (-")
	SZA
	TAD (")-"]
	SNA CLA
	JMS I [GETC	/GET NEXT CHARACTER
	JMP I (NUMBE5	/RETURN TO EXPRESSION PROCESSOR


PEZE,	0		/SUBR TO ISSUE PE OR ZE MESSAGE
	SNA CLA		/WHICH ONE?
	JMP .+4	/PAGE 0
	JMS I PERROR
	PE
	JMP I PEZE
	JMS I PERROR
	ZE
	JMP I PEZE
/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	/GET PG ADDR OF 1ST LITERAL IN BUFFER
FIND02,	DCA FINDS3
	TAD FINDS2
	JMS I [RTL6
	TAD [LITBUF
	DCA TEMP
	TAD FIND0	/COMPUTE ACTUAL CORE ADDRESS OF LITERAL
	TAD I TEMP
	DCA TEMP2
	TAD FINDS3	/COMPUTE THE NUMBER OF ENTRIES
	CIA
	TAD I TEMP	/IN THE LITERAL BUFFER
	SNA
	JMP FINDS6	/NONE
	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	/PAGE FULL - WHICH PAGE?
	JMS PEZE	/GENERATE PE OR ZE MESSAGE
	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 ICMESG	/PRINT IC MESSAGE AND GET NEXT CHAR
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
	AC7776
IFTST6,	CMA
	TAD CONDSW
	DCA CONDSW
IFTST4,	DCA I [LINBUF	/INHIBIT LISTING OF UNASSEMBLED CODE -
			/ZEROED IF /J OPTION NOT SPECIFIED
	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
IFTST7,	JMS I [SPNOR	/IGNORE SPACES
	JMS I [TSTALP	/IS NEXT CHARACTER ALPHABETIC
	JMP IFTST8	/YES
	JMS ICMESG	/PRINT IC MESSAGE AND GET NEXT CHAR
	JMP IFTST7	/KEEP TRYING

IFTST8,	JMS I [GETTAG	/PICK UP TAG
	DCA VALUE	/STORE UNDEFINED INDICATOR
	TAD TAG3	/WAS IT A PSEUDO-OP?
	SMA CLA
	JMP IFTST9	/NO
	JMS I [ERROR	/YES - GENERATE IP ERROR MESSAGE
	IP
	JMP IFTST9

ICMESG,	0
	JMS I	[ERROR
	IC		/IC COMES OUT ON ALL PASSES
	TAD CHAR
	SPA CLA
	JMP I [LOOKEX	/END OF LINE - GO AWAY
	JMS I [GETC	/GET NEXT CHAR
	JMP I ICMESG
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 PUSHA1	/BE**FATAL ERROR**
	TAD TEMP	/NO - MAKE ENTRY
	DCA I PDLXR
	CLA CMA
	TAD PDLXR
	DCA PDLXR
	JMP I PUSHA	/--RETURN--

PUSHA1,	TAD (BE
	JMP I [MONERR	/PUSHDOWN OVERFLOW IS FATAL ERROR
/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 (-"9-1
	CLL
	TAD ("9-"0+1
	SNL CLA		/CHECK FOR RANGE 0-9
	ISZ TSTNUM	/OUT OF RANGE
	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 (-"Z-1
	CLL
	TAD ("Z-"A+1
	SNL CLA		/CHECK FOR RANGE A-Z
	ISZ TSTALP	/OUT OF RANGE
	JMP I TSTALP	/--RETURN--
	PAGE
/INPUT ROUTINE
/UNPACKS CHARACTERS FROM BUFFER

INPUT,	0
	ISZ INCHCT	/ARE THERE CHARACTERS LEFT IN BUFFER? 
	JMP I CHARLV	/YES - FETCH ONE
	TAD INEOF	/NO - WAS OLD FILE ENDED?
	SZA CLA
	JMP ENDCHR	/YES - START NEW FILE
INGBUF,	TAD INCTLA	/NO
	AND [7600
	JMS I [RTL6
	TAD INCTR
	SNL
	DCA INCTR
	SZL
	ISZ INEOF
	CLL CML CMA RTR	/SET CONTROL WORD
	RTR
	RTR
	TAD INCTLA
	DCA INCTLW
	JMS I INHNDL	/CALL INPUT DEVICE HANDLER
INCTLW,	0		/CONTROL WORD
INBUFP,	INBUF		/INPUT BUFFER ADDRESS
INREC,	0		/STARTING BLOCK NUMBER
	JMP INERRX	/ERROR RETURN
INBREC,	TAD INCTLA	/NORMAL RETURN
	AND [7600
	JMS I [RTL6
	TAD INREC
	DCA INREC	/RESET STARTING BLOCK NUMBER
	TAD INCTLW
	AND [7600
	CLL RAL
	TAD INCTLW
	AND [7600
	CIA
	DCA INCHCT	/SET CHARACTER COUNT
	TAD INBUFP
	DCA INPTR	/SET BUFFER POINTER
/CHARACTERS ARE FOUND IN BUFFER
/IN STANDARD OS/8 PACKING
/WORD 1: AAA A11 111 111
/WORD 2: BBB B22 222 222
/WHICH REPRESENTS 3 CHARACTERS
/CHARACTER 1: 11 111 111
/CHARACTER 2: 22 222 222
/CHARACTER 3: AA AAB BBB


ICHAR1,	TAD I INPTR	/PICK UP CHARACTER WORD 1
	JMS CHARLV	/CHECK RIGHT 8 BITS
ICHAR2,	TAD I INPTR	/PICK UP WORD 1
	ISZ INPTR	/(INCREMENT POINTER TO WORD 2)
	AND [7400	/WITH WORD 1 IN AC
	DCA INCTLW	/RETRIEVE LEFT 4 BITS AND SAVE
	TAD I INPTR	/PICK UP WORD 2
	JMS CHARLV	/CHECK RIGHT 8 BITS
ICHAR3,	TAD I INPTR	/PICK UP WORD 2
	ISZ INPTR	/(POINT TO NEXT WORD 1)
	AND [7400	/WITH WORD 2 IN AC
	CLL RTR		/RETRIEVE LEFT 4 BITS
	RTR
	TAD INCTLW	/PUT BOTH SETS OF 4 BITS TOGETHER
	RTR
	RTR
	JMS CHARLV	/CHECK CHARACTER
	JMP ICHAR1	/TRY NEXT SET OF 2 WORDS

INERRX,	ISZ INEOF
	SMA CLA		/EOF OR FATAL ERROR?
	JMP INBREC	/EOF - UNPACK THIS BUFFER
	JMP I (SYSERR	/FATAL - GENERATE DE ERROR MESSAGE

INCHCT,	-1
INEOF,	1
INPTR,	0
INCTR,	0
INCTLA,	0
INFPTR,	7617
/START NEW FILE

ENDCHR,	ISZ I (FORMSW	/^Z OR EOF SIMULATES FORM FEED
	TAD PASS	/IS THIS PASS 3?
	SPA SNA CLA
	JMP NXTFLE	/NO
	JMS I (HEDCLR	/YES - CLEAR HEADING BUFFER
	TAD [-HEDLEN
	DCA I (LSTCH6
	TAD [HEADER-1
	DCA I (LSTCH7
	DCA LSTCNT
NXTFLE,	TAD (INDEVH+1	/SET ADDRESS OF DEVICE HANDLER
	DCA INHNDL
	CDF 10
	TAD I INFPTR
	CDF
	SNA
	JMP FAKDLR	/END OF FILE - FAKE A $
	CIF 10
	JMS I IOMON	/CALL USER SERVICE ROUTINES
	1		/*FETCH HANDLER*
INHNDL,	0		/LOADING ADDRESS OF HANDLER
	HLT		/ERROR RETURN
	CDF 10		/V3C
	TAD INHNDL	/NORMAL RETURN - HANDLER IN CORE
	AND [7600
	TAD [-INDEVH	/SEE IF INPUT HANDLER IS IN 7200
	SZA CLA
	JMS I (PTCH	/IT IS - INCREASE SIZE OF BUFFER
			/AND REMOVE FROM RESIDENCY ANY HANDLERS THERE
	TAD INCTL
	DCA INCTLA	/DF=10
	TAD I INFPTR
	AND [7760
	SZA
	TAD [17
	CLL CML RTR
	RTR
	DCA INCTR
	ISZ INFPTR
	TAD I INFPTR
	DCA INREC	/RESET STARTING BLOCK NUMBER
	ISZ INFPTR
	DCA INEOF
	CDF
	JMP INGBUF
FAKDLR,	TAD (244
	JMS CHARLV	/CALL THE COROUTINE
	TAD [215	/WITH $ AND CR
	JMS CHARLV	/TO END THE ASSEMBLY.
	JMP I (PHASE	/** DIDN'T WORK - MUST BE IN CONDITIONAL - FATAL

CHARLV,	0		/CHARACTER IN AC
	AND [177	/AND OFF LEFT 5 BITS
	JMP I (LSTCH9	/RETURN TO LSTCH9
	PAGE
/HANDLER FOR DTORG PSEUDO-OP (TYPESETTING)
/PUNCHES 4 DIGIT BLOCK NUMBER IN 2 FRAMES
/FIRST FRAME HAS CHANNELS 7 AND 8 PUNCHED
/ADDED TO CHECKSUM

DTORGX,	JMS I [SPNOR	/IGNORE SPACES
	JMS I [EXP	/GET EXPRESSION
	TAD PASS	/IS THIS PASS 2?
	SNA
	JMP DTORG2	/YES
PUNVA1,	SPA SNA CLA	/NO - IS THIS PASS 3?
	JMP I [LOOKEX	/NO--EXIT TO MAIN--
	TAD LININD	/GET LINK SWITCH FROM "EXP"
	DCA LINKSW	/YES
	TAD [LOOKEX	/FIX PUNONE TO EXIT TO MAIN
	DCA I (PUNONE
	TAD [211	/OUTPUT TAB
	JMS I OERROR
	JMP I (DTORG1

DTORG2,	TAD VALUE	/PASS 2 - GET BLOCK NUMBER
	JMS I [RTL6
	RAL
	AND [77
	TAD (300	/PICK UP CHANNELS 7 AND 8
	DCA TEMP
	TAD TEMP
	TAD CHKSUM	/ADD VALUE TO CHECKSUM
	DCA CHKSUM
	TAD TEMP
	JMS I OCHAR	/OUTPUT BLOCK NUMBER - FIRST FRAME
	TAD VALUE
	AND [77
	JMS I OCHAR	/OUTPUT SECOND FRAME
	JMP I [LOOKEX	/--EXIT TO MAIN--

/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
/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
	DCA I [LINBUF	/XLIST NEVER LISTS!
	JMP I [LOOKEX	/--EXIT TO MAIN--

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

RELOCY,	JMS XLISTZ	/RELOCATE PSEUDO-OP - EXPRESSION?
	JMP RELOC1	/NO
	JMS I [EXP	/GET IT
	TAD VALUE
	CIA		/COMPUTE OFFSET OF REL LOC CTR
	TAD LOC		/FROM FAKE LOC CTR
	TAD OFFSET	/OFFSET IS CUMULATIVE!
RELOC2,	DCA OFSBUF	/SET NEW OFFSET - THIS TAKES EFFECT AFTER
	STA		/THE LITERALS (IF ANY) ARE DUMPED.
	JMP I (STAR0	/FAKE ORIGIN TO NEW LOC,
			/ACTUALLY A NO-OP BECAUSE OF OFFSET
RELOC1,	TAD OFFSET	/SET OFSBUF=0, LOC=LOC+OFFSET -
	TAD LOC		/THIS CANCELS ALL RELOCATION STUFF.
	DCA VALUE
	DCA UNDFSW	/JUST IN CASE - "STAR0" CHECKS THIS
	JMP RELOC2	/STILL MUST OUTPUT *. TO GET IN SYNCH
/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 [-HEDLEN
	DCA EJECT7	/SET UP FOR 40 NEW CHARACTERS
	TAD [HEADER-1
	DCA XREG1	/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 XREG1
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--
PUNVAL,	TAD PASS	/IS THIS PASS 3?
	JMP PUNVA1	/IF SO, LIST STUFF


/SEE IF EXPRESSION FOLLOWS XLIST
/SKIP ON EXPRESSION

EJECT7,
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
	0
	OCTAL
	PAGE
/*********************************************************************

INBUF=.			/INPUT BUFFER 

OUBUF=.			/OUTPUT BUFFER

OUDEVH=.+400		/OUTPUT DEVICE HANDLER

INDEVH=7200		/INPUT DEVICE HANDLER

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

/	EXPLANATION OF PAL8'S BUFFER ALLOCATION ALGORITHM

/PASS1:

/	THE INPUT BUFFER STARTS AT 5600 AND ENDS AT 7200
/	THE INPUT HANDLER GOES IN 7200-7600.
/	THERE IS NO OUTPUT HANDLER.
/	HOWEVER, IF THE CURRENT INPUT HANDLER DOES NOT
/	LOAD INTO 7200, THEN THE BUFFER SIZE IS INCREASED
/	SO THAT THE INPUT BUFFER IS 5600-7600

/PASS2 AND PASS3:

/	THE OUTPUT BUFFER IS ALWAYS 1 BLOCK LONG, LOCATED
/	AT 5600-6200.
/	THE OUTPUT HANDLER RESIDES IN 6200-6600.
/	THE INPUT HANDLER RESIDES IN 7200-7600.
/	THE INPUT BUFFER NORMALLY RESIDES IN 6600-7200
/	BUT MAY GROW OVER EITHER THE INPUT HANDLER AREA OR
/	THE OUTPUT HANDLER AREA, IF EITHER OR BOTH OF THESE
/	DON'T EXIST.

/WHENEVER A BUFFER GROWS OVER A HANDLER AREA, THE MONITOR
/HANDLER RESIDENCY TABLE IS SEARCHED TO SEE IF THERE
/WERE ANY HANDLERS THERE.  IF ANY HANDLERS WERE THERE IN THE PAST,
/THEY ARE NOW MARKED AS BEING NON-RESIDENT.
/MORE ONCE ONLY CODE

OTYPE,	0
	DCA TEMP
	CDF 10
	TAD I TEMP
	AND [17		/GET DEVICE NUMBER
	TAD (DCB-1
	DCA TEMP
	TAD I TEMP	/GET DCB ENTRY
	CDF
	JMP I OTYPE	/--RETURN--

/CHECK TO SEE HOW MUCH CORE EXISTS
/AND STORE SYMBOL TABLE ACCORDINGLY

	IFZERO	HASH<
BEGINF,	CDF 10		/WAS THE /K OPTION SELECTED TO
	TAD I (MPARAM	/CHECK FOR MORE THAN 8K?
	CDF 0
	RTR
ZK7630,	SNL CLA		/YES
	JMP I (CKBAT	/NO - CHECK FOR BATCH, USE 8K ONLY
	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 OPTIM4	/1
	TAD [177	/IF FIELD 5, ALLOW 4095 SYMBOLS
FLD1,	TAD (1740	/OTHERWISE ALLOW 1740*(NR OF FIELDS)
	TAD (1740
	TAD (1740
OPTIM0,	TAD (1740
	DCA I (TAGMAX	/SET HIGHEST ADDRESS FOR TAGS
	JMP I (BEGING

OPTIM4,	TAD I OPTIM1	/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 OPTIM0
	>

	IFNZRO	HASH<
	/SIZE CHECK OUR MACHINE

BEGINF,	CDF	10
	TAD I	(MPARAM
	CDF
	RTR		/K TO LINK
ZK7630,	SNL CLA		/ALTER FOR COMPLEMENT OF K
	TAD	[400	/TAD TO KEEP USR
	DCA I	(USROFS
	CDF	50
	JMS	FLD2
	ISZ	HIFLD
	CDF	40
	JMS	FLD2
	ISZ	HIFLD
	CDF	30
	JMS	FLD2
	ISZ	HIFLD
	CDF	20
	JMS	FLD2
	ISZ	HIFLD
	TAD I	(7777	/CHECK SOFT CORE SIZE
	AND	(70
	SNA
	JMP	CKSEV	/NOT THERE
	CLL RTR
	RAR
	DCA	HIFLD	/THERE, SET HIFLD WITH IT
	TAD	HIFLD	/TAKE MIN(HIFLD,5)
	TAD	(7772
	SMA CLA		/SMA TO USE HIFLD
	TAD	(5	/ELSE USE 5
	SZA
	DCA	HIFLD	/STORE 5 IF NECESSARY
CKSEV,	CDF	10
	TAD I	(MPARAM+2	/LOOK AT /7
	CDF
	AND	(4
	SNA CLA		/SNA IF THERE
	JMP I	(CKBAT	/ELSE CHECK FOR BATCH
	TAD	(-7	/SET TO PRINT 7 COLUMNS OF STAB
	DCA I	(SYMNCL
	TAD	(67^6	/SET OFFSET TO FIRST SYMBOL ON NEXT PAGE
	DCA I	(SYMOFS
	JMP I	(CKBAT	/OK, CHECK FOR BATCH NOW
OPTIM4,	SNL		/SNL IF BATCH RUNNING
	JMP I	(BEGING	/ELSE TAKE DEFAULT TABLE SIZE
	TAD	(BPRIME/SET ALTERNATE TABLE SIZE
	DCA I	(PRIMES	/INTO THE ONCE ONLY CODE
	JMP I	(BEGING	/NOW HIFLD=# OF HIGHEST USABLE FIELD
HIFLD,	1		/8K MINIMUM
	>

/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
	IFZERO	HASH<

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

OPTIM5,	OPTIMB
OPTIM6,	GETTG5
OPTIM7,	-21

OPTIMA,	RELOC SETFLD+1

	CLL CMA RTL
	TAD STM202
	DCA TAGXR
	CDF 10
	JMP I SETFLD
STM202,	-202
SETFL4,	4
	RELOC

OPTIMB,	RELOC GETTG5

	TAD HIGHTG
	JMS SETFLD
	TAD TAGXR
	DCA XREG1
	TAD XREG1
	TAD SETFL4
	DCA XREG2
	TAD THISTG
	JMS SETFLD
OPTIML,	TAD I XREG2
	DCA I XREG1
	TAD XREG1
	CIA
	TAD TAGXR
	SZA CLA
	JMP OPTIML
	CDF
	RELOC
	>
/OVERLAY CODE FOR DDT SYMBOL TABLE PRINT

DSWIT2,	IFZERO	HASH<
	RELOC SYMPR9-2
	JMP SYMPRE
SYMPRD,	TAD SYM204
	JMS I OERROR
	TAD [377
	JMS I OERROR
	JMS SYMPRC
	DCA LINCNT
	JMP I SYMPRT
SYMPRC,	0
	TAD [-200
	DCA SYMPR2
	TAD [200
	JMS I OERROR
	ISZ SYMPR2
	JMP .-3
	JMP I SYMPRC
	RELOC
	>
	IFNZRO	HASH<
	RELOC	SYMDDT
	ISZ	THISTG
	JMP	SYMLUP
SYMXIT,	TAD	SYM204
	JMS I	OERROR
	TAD	[377
	JMS I	OERROR
	JMS	DDTLDR
	DCA	LINCNT
	JMP I	SYMPRT
DDTLDR,	0
	TAD	[7600
	DCA	SYMCCT
	TAD	[200
	JMS I	OERROR
	ISZ	SYMCCT
	JMP	.-3
	JMP I	DDTLDR
SYM204,	204
	RELOC
	>
DSWITB=	.
	PAGE
BEGING,	CIF 10
	JMS I IOMON	/CALL THE USR
	12		/TO FIND OUT DSK:
BEGINJ,	TEXT /DSK/
	7201		/DUMMY
	HLT		/NEVER!
/V3C	TAD BEGINJ+1	/GET DEVICE NUMBER OF DSK:
/V3C	DCA CC7		/AND SET IT
	TAD BEGINJ+1
	DCA I BEGINL	/AND SET IT INTO "PALBIN"
	CDF 10
	TAD I CC1	/GET PARAMETER WORD 1
	CDF
	CLL RTL		/OPTION /B INTO LINK
	AND [400	/IS IT /F?
ZF7650,	SZA CLA
	DCA I CCX1	/YES: /F => NO 0 FILL
ZB7430,	SNL		/IS IT /B?
	JMP .+3
	TAD CCX2
	DCA I CCX3	/YES: /B => ! IS SHIFT
	CDF 10
	TAD I CC1	/GET WORD 1 AGAIN
	CDF
	AND [200	/IS IT /E?
ZE7640,	SNA CLA
	JMP .+3
	TAD CCX8
	DCA I CCX4	/YES: /E => SET 'LG' ERROR
	CDF 10
	TAD I CCX5	/GET WORD 2 THIS TIME
	CDF
	RTL
ZO7710,	SMA CLA		/IS IT /O?
	JMP .+3
	DCA I CCX6	/YES: /O => NO 200 ORG
	ISZ I CCX7
	CDF 10
	TAD I CC1	/GET WORD 1 AGAIN
	AND CC2		/IS IT /C?
	SNA CLA
	JMP I CC3	/NO: TRY FOR /L OR /G
	TAD I CC4	/CREF FILE SPECIFIED?
	SZA CLA
	JMP CC5		/YES
CC6,	TAD CC7		/NO: GIVE "CREFLS.TM"
	DCA I CC4
	ISZ CC6
	ISZ CC4
	ISZ CC8
	JMP CC6
CC5,	CDF
	CIF 10
	CLA IAC
	JMS I IOMON	/LOOKUP "CREF.SV"
	2
CC13,	CC9		/POINT TO NAME - BACK WITH START
CC8,	-5		/LENGTH GOES HERE
	JMP CC16	/NOT FOUND!
	TAD CC30
	JMS I CC31	/CHECK TYPE FILE
	SMA CLA
	JMP CC16	/NOT DIRECTORY IS ERROR
	TAD CC12
	DCA I CC121	/CSWITC=TAD I [7605
	TAD CC11
	DCA I CC111	/CSWIT1=CLA
	TAD CC10
	DCA I CC101	/CSWIT2=DCA BINSRT
	DCA I CC171	/CMOVE=0
	TAD CC13
	DCA I CC131	/CHAIN="CREF.SV"
	DCA I CC141	/LSWITC=0
	TAD CC30
	DCA I CC301	/NOPA22=7612
	DCA I CC20	/"BEGIAB"=0
	TAD CC21
	DCA I CC211	/"DIRSW1"=TAD [177
	TAD CC22
	DCA I CC221	/"PTPSW1"=TAD [232
	JMP I .+1
	CCC		/KEEP GOING (SIGH)

CC16,	JMS I [ERROR
	CF		/OPTION /C ERROR
	JMP I CC3	/TRY FOR /L OR /G
CC171,	SWAPR2+CMOVE
CC141,	LSWITC
CC131,	CHAIN
CC121,	CSWITC
CC12,	TAD I [7605
CC111,	CSWIT1
CC11,	CLA
CC101,	SWAPR2+CSWIT2
CC10,	DCA BINSRT
CC301,	SWAPR2+NOPA22
CC30,	7612
CC31,	OTYPE
CC1,	MPARAM
CC2,	1000
CC3,	BEGINH
CC4,	7612

CCX1,	TEXT4X		/V3C
CCX2,	OP3
CCX3,	OPEXPL
CCX4,	LGERR
CCX5,	MPARAM+1
CCX6,	FIELDY+1
CCX7,	FIELDY+2
CCX8,	JMS I PERROR

CC7,	1
	FILENAME CREFLS.TM
CC9,	FILENAME CREF.SV

CC20,	BEGIAB
CC21,	TAD [177
CC211,	SWAPR2+DIRSW1
CC22,	TAD [232
CC221,	SWAPR2+PTPSW1

BEGINL,	PALBIN
	PAGE
/***********************************************************************
/SYMBOL TABLE
/MOVED BY ASSEMBLER TO FIELD 1
/MUST REMAIN IN ALPHABETICAL ORDER
/***********************************************************************

SYMS,	5777			/TERMINATOR
	3777			/IMPOSSIBLE (LIMITING) SYMBOL
	5777
	0000
	IFNZRO	HASH<		/PSEUDO OPS MUST GO FIRST FOR EXPUNGE
	"I-300^45+4000+2000	/I
	0
	0
	0400

	"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

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

	"R-300^45+"E-300+4000	/RELOC
	"L-300^45+"O-300
	"C-300^45+4000
	RELOCY

	"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


	"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

	"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	/FILENAME
	"L-300^45+"E-300
	"N-300^45+"A-300+4000
	FILENX

	"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+"T-300+4000	/DTORG
	"O-300^45+"R-300
	"G-300^45+4000
	DTORGX

	"D-300^45+"E-300+4000	/DEVICE
	"V-300^45+"I-300
	"C-300^45+"E-300+4000
	DEVICX

	"D-300^45+"E-300+4000	/DECIMAL
	"C-300^45+"I-300
	"M-300^45+"A-300+4000
	DECIMX
	>
	"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
	IFZERO	HASH<
	"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+"S-300+4000	/RSF
	"F-300^45
	0
	RSF
	"R-300^45+"R-300+4000	/RRB
	"B-300^45
	0
	RRB

	"R-300^45+"P-300+4000	/RPE
	"E-300^45
	0
	6010

	"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+"F-300+4000	/RFC
	"C-300^45
	0
	RFC
	IFZERO	HASH<
	"R-300^45+"E-300+4000	/RELOC
	"L-300^45+"O-300
	"C-300^45+4000
	RELOCY
	>
	"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+"S-300+4000	/PSF
	"F-300^45
	0
	PSF

	"P-300^45+"P-300+4000	/PPC
	"C-300^45
	0
	PPC

	"P-300^45+"L-300+4000	/PLS
	"S-300^45
	0
	PLS

	"P-300^45+"C-300+4000	/PCF
	"F-300^45
	0
	PCF

	"P-300^45+"C-300+4000	/PCE
	"E-300^45
	0
	6020
	IFZERO	HASH<
	"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+"P-300+4000	/OPR
	"R-300^45
	0
	OPR
	IFZERO	HASH<
	"O-300^45+"C-300+4000	/OCTAL
	"T-300^45+"A-300
	"L-300^45+4000
	OCTALX
	>
	IFZERO	HASH<
	"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+"A-300+4000	/LAS
	"S-300^45
	0
	LAS

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

	"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+"I-300+4000	/KIE
	"E-300^45
	0
	6035

	"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	/IOT
	"T-300^45
	0
	IOT

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

	"I-300^45+"O-300+4000	/IOF
	"F-300^45
	0
	IOF
	IFZERO	HASH<
	"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
	>
	IFZERO	HASH<
	"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
	IFZERO	HASH<
	"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
	IFZERO	HASH<
	"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	/FILENAME
	"L-300^45+"E-300
	"N-300^45+"A-300+4000
	FILENX

	"F-300^45+"I-300+4000	/FIELD
	"E-300^45+"L-300
	"D-300^45+4000
	FIELDX
	>
	IFZERO	HASH<
	"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+"T-300+4000	/DTORG
	"O-300^45+"R-300
	"G-300^45+4000
	DTORGX

	"D-300^45+"E-300+4000	/DEVICE
	"V-300^45+"I-300
	"C-300^45+"E-300+4000
	DEVICX

	"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	/CDF
	"F-300^45
	0
	CDF

	"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

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

SYME=.

/**********************************************************************
/TOP OF SYMBOL TABLE
/**********************************************************************
SWAP2=.

/**********************************************************************
/CODE UNIQUE TO PASSES 1 AND 2
/SWAPPED IN FOR PASSES 1 AND 2
/OVERLAYED DURING PASS 3	*** NO LITERALS ***

	RELOC 1000		/ASSEMBLED INTO 1000-1247

	SWAPB2=	.
	SWAPR2=	SWAP2-SWAPB2	/RELOCATION FACTOR FOR THIS CODE

OOPEN,	0
	TAD OPEN01	/OPEN BINARY AND LISTING FILES
	DCA XOUHND	/SET ADDRESS OF DEVICE HANDLER
	TAD OPEN02
	DCA XOUBLK
	TAD [-5
	DCA XOUELE	/SET NEW OUTPUT FILE LENGTH
	CDF 10
	TAD I OUFPTR
	CDF
	DCA I XOUBLK
	ISZ XOUBLK
	ISZ OUFPTR
	ISZ XOUELE	/INCREMENT OUTPUT FILE LENGTH
	JMP .-7
	TAD OPEN02
	IAC
	DCA XOUBLK	/SET POINTER TO NEW FILENAME
	TAD XOUBLK
	DCA I OPEN04
	CIF 10
	JMS I IOMON	/CALL USER SERVICE ROUTINES
	13		/*RESET SYSTEM TABLES*
	DCA I OPEN05	/DELETE UNCLOSED FILES AND
	TAD I OPEN02	/DELETE HANDLERS
	AND [17		/GET NEW DEVICE HANDLER #
	SNA		/OUTPUT INHIBIT?
	JMP ONOFIL	/YES
	CIF 10		/NO
	JMS I IOMON	/CALL USER SERVICE ROUTINE
	1		/*FETCH DEVICE HANDLER*
XOUHND,	0		/LOADING ADDRESS
	HLT		/HANDLER NOT AVAILABLE
OUENTR,	TAD I OPEN02	/NORMAL RETURN - GET OUTPUT
	CIF 10		/DEVICE NUMBER AND FILE LENGTH
	JMS I IOMON	/CALL NEW SERVICE ROUTINES
	3		/*ENTER OUTUT FILE
XOUBLK,	0		/POINTER TO FILENAME
XOUELE,	0		/FILE LENGTH
	JMP OEFAIL	/ERROR RETURN
	DCA I OPEN06	/NORMAL RETURN
	JMS I OPEN07
	TAD XOUHND
	TAD [200	/LINK IS CLEAR!!
	SNL CLA
	TAD [400
	TAD OUFDEV
	DCA I OUFINP
	TAD I OUFINP
	CLL RAR
	CIA
	TAD OU3501
	DCA INCTL
	ISZ OOPEN
	TAD XOUHND
	DCA I OPEN09
	TAD XOUBLK
	DCA I OPEN10
	TAD XOUELE
	DCA I OPEN11
	JMP I OOPEN	/--RETURN--

OEFAIL,	TAD I OPEN02
	AND [7760
	SNA CLA
	JMP I OPEN12	/DE**FATAL ERROR**
	TAD I OPEN02
	AND [17
	DCA I OPEN02
	JMP OUENTR

ONOFIL,	ISZ I OPEN05	/SET OUTPUT INHIBIT SWITCH
	JMP I OOPEN	/--RETURN--

OUFPTR,	7600

OPEN01,	OUDEVH+1
OPEN02,	OUFILE
OPEN04,	OUCNAM
OPEN05,	OUTINH
OPEN06,	OUCCNT
OPEN07,	OUSETP
OPEN09,	OUHNDL
OPEN10,	OUBLK
OPEN11,	OUELEN
OPEN12,	SYSERR
OU3501,	3501
OUFDEV,	OUDEVH
OUFINP,	INBUFP
/CONTINUATION OF FIXTAB HANDLER

FIXTAY,	IFZERO	HASH<
	TAD HIGHTG	/SET POINTERS TO TABLE
	CMA
	>
	IFNZRO	HASH<
	TAD	TAGMAX
	CIA
	>
	DCA TEMP3
	DCA THISTG
FIXTAX,	JMS I [FINDTG	/GET A TAG
	AC3777
	AND TAG1
	IFNZRO	HASH<
	SZA
	>
	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--


/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,
IOPEN,	0		/SET UP INPUT ROUTINE
	CLA CMA		/TO OPEN FILE
	DCA I IOPEN1
	ISZ I IOPEN2
	TAD IOPEN3
	DCA I IOPEN4
	ISZ I IOPEN5
	TAD [LINBUF+120
	DCA TXTPTR
	JMP I IOPEN	/--RETURN--

IOPEN1,	INCHCT
IOPEN2,	INEOF
IOPEN3,	7617
IOPEN4,	INFPTR
IOPEN5,	FORMSW
	PAGE
/START PASS 2	*** NO LITERALS HERE EITHER ***

START1,	TAD [ERROR
	DCA PERROR	/RESET PREUDO-ERROR ROUTINE
	JMS I ST1OPN	/OPEN PASS 2 OUTPUT FILE
	JMP NOPA21	/NO PASS 2 IF PASS 3
NOPA23,	TAD I ST1OBL
	DCA BINSRT
	DCA PUNCHX	/CLEAR PUNCH INHIBIT
	JMS START3
	JMP I .+1
	START2-1

NOPA21,	CDF 10
	TAD I NOPA22	/IS THERE A PASS 3?
	CDF
	SNA CLA
	JMP NOPA23	/NO - DO PASS 2
	ISZ PASS	/SKIP PASS 2
	NOP
	JMP NOPAS2	/CONTINUE TO PASS 3

NOPA22,	7605

START3,	0		/GENERATE LEADER/TRAILER
	TAD LEADER
	DCA TXTPTR
	TAD [200
	JMS I OCHAR
	ISZ TXTPTR
	JMP .-3
	JMP I START3	/--RETURN--

LEADER,	-10
/END PASS 2

ENDPA2,	JMS I [DUMPZ	/DUMP PAGE 0 LITERALS
	DCA PUNCHX
	CLL		/V3C
	TAD CHKSUM	/OUTPUT CHECKSUM
	JMS I [PUNOUT	/PUNCH THE CHECKSUM
	JMS START3	/GENERATE LEADER/TRAILER
	JMS I EN2CLS	/CLOSE PASS 2 OUTPUT FILE
NOPAS2,	TAD EN2LSO
	DCA OERROR	/SET NEW OUTPUT TO BE LISTING
	ISZ I EN2OU1
CMOVE,	JMP CMOVA	/ZEROED IF /C
	CDF 10		/MOVE CODE FOR /C OPTION
CMOVB,	TAD I CMOV1
	DCA I CMOV2	/MOVE OUTPUT FILE STORAGE
	ISZ CMOV1
	ISZ CMOV2
	ISZ CMOV3
	JMP CMOVB	/LOOP
CMOVA,	CDF
	JMS I ST1OPN	/OPEN 3RD PASS FILE
	DCA I CMOV4	/NO 3RD PASS
	TAD I ST1OBL	/GET FILE START
CSWIT2,	CLA		/"DCA BINSRT" IF /C
	TAD PTPSW1
	DCA I EN2PTP	/RESET PAPERTAPE SWITCH
	TAD DIRSW1
	DCA I EN2DIR	/RESET DIRECTORY SWITCH
	JMS I PIOPEN
	JMP I .+1
	LOADOV		/OVERLAY THIS AREA WITH PASS3 CODE

PIOPEN,	IOPEN
DIRSW1,	TAD [177
PTPSW1,	TAD [232

CMOV1,	7605
CMOV2,	7600
CMOV3,	-12
CMOV4,	NSWITC
EN2CLS,	OCLOSE
EN2LSO,	LISOUT
EN2OU1,	OUTPT1
EN2PTP,	PTPSW
EN2DIR,	DIRSW
ST1OPN,	OOPEN
ST1OBL,	OUBLK
SWAPE2,	RELOC
	IFNZRO	ENDOVL-SWAPE2&4000 <OVLERR,__ERROR__>
	PAGE
	IFNZRO	HASH<

	/ONCE ONLY CODE TO HASH OUT THE PERMANENT SYMBOLS

HSHSMS,	0
	JMS I	(7607	/WRITE THE SYMBOL TABLE SORT OVERLAY
	4210		/2 PAGES FROM FIELD 1
	OUDEVH+400	/FROM HERE
	ASWAP+1		/TO HERE
	JMP I	(SYSERR/WONDERFUL.
	TAD I	(USROFS
	SZA CLA		/SZA IF KICKING OUT USR
	TAD	(12	/ELSE FUDGE POINTER
	TAD I	(HIFLD	/FIRST SET HASH TABLE SIZE
	TAD	PRIMES	/ACCORDING TO CORE SIZE
	DCA	PRIME
	TAD I	PRIME
	DCA	PRIME
	TAD	PRIME
	CIA
	DCA I	(MPRIME
	TAD I	(USROFS
	SZA CLA
	JMP	KPUSR	/JMP IF KEEPING USR
	CDF	10	/SERVE NOTICE WE'RE OCCUPYING FIELD 1
	AC7776
	AND I	(JSBITS
	DCA I	(JSBITS
	TAD	[7700
	DCA	IOMON	/AND POINT AT PROPER MONITOR E.P.
KPUSR,	CDF
	TAD I	(MPRIME	/HOW MANY SLOTS TO WIPE
	DCA	LAST3	/TO COUNTER
	TAD I	(USROFS
	CLL RTL
	TAD	(7777	/FUDGE THE INITIAL AUTO XR
	JMP	CLRGO	/INTO THE LOOP NOW
CLRLUP,	TAD	LAST1
	TAD	(-7577
	SZA CLA		/SZA IF NEED TO DO NEXT FIELD
	JMP	CLCDF0+1/ELSE CLEAR ANOTHER
	TAD	(10
	TAD	CLCDF0
	DCA	CLCDF0	/CDF INSTR GETS BUMPED
	STA
CLRGO,	DCA	LAST1	/XRGETS SET
CLCDF0,	CDF	10	/INITIALLY CDF 10
	DCA I	LAST1
	DCA I	LAST1
	DCA I	LAST1
	DCA I	LAST1
	ISZ	LAST3	/SKP IF NO MORE
	JMP	CLRLUP	/ELSE DO ANOTHER
	CDF		/THE TABLE IS CLEAN
	TAD	(HSHRTN
	DCA I	[GETTAG
	STA
	DCA	HIGHTG	/HIGHTG=CURRENT SYMBOL INDEX
	TAD	(SYMS+3	/USE THESE AUTO XR'S NOW
	DCA	LAST1
	TAD	LAST1
	DCA	LAST2
HSHLP,	TAD I	LAST1
	AND	[1777	/FIRST, STRIP THE TYPE BITS
	DCA I	(NAME1
	AC3777
	AND I	LAST1
	DCA I	(NAME2
	AC3777
	AND I	LAST1
	DCA I	(NAME3
	ISZ	LAST1	/SKIP THE VALUE
	JMP I	(GETTGH	/GO FIND IT'S PLACE
HSHRTN,	CLA CLL
	TAD I	LAST2
	DCA I	(NAME1
	TAD I	LAST2
	DCA I	(NAME2
	TAD I	LAST2
	DCA I	(NAME3
	TAD I	LAST2
	DCA	VALUE2
	JMS I	(INSRTG	/AND STORE IT
	TAD	LAST1
	TAD	(1-SYME+4
	SZA CLA
	JMP	HSHLP	/LOOP IF MORE TO GO
	JMP I	HSHSMS	/--RETURN--

PRIMES,	.
	1737	/1 FIELD
	3673	/2 FIELDS
	5633	/3 FIELDS
	7577	/4 FIELDS
	7775	/5 FIELDS (THE LAST MOSTELY WASTE)
	BPRIMES=.-1	/ALTERNATE TABLE SIZE FOR BATCH COMPATABILITY
	1737	/1 FIELD (MEANS NO BATCH)
	3133	/2 FIELDS
	5075	/3 FIELDS
	7035	/4 FIELDS
	7775	/5 FIELDS (SOME OF WASTE FOR BATCH)

	1335	/STILL ANOTHER ALTERNATE SET IF KEEPING USR
	3273
	5237
	7175
	7775

	0
	2535
	4465
	6437
	7775

	PAGE
	>
/**************************************************************
/PAGE 0 LITERALS
/**************************************************************
	IFNZRO	HASH<

	/SYMBOL TABLE SORT OVERLAY
	/ONLY SWAPPED IF TABLE WILL BE LISTED

	/FIRST, SOME EQUATES

	PPUTTAG=	[PUTTAG
	PFINDTG=	[FINDTG
	O1777=		[1777
	O7774=		[7774

	SXR=	XREG1
	TXR=	XREG2
	SXR2=	LAST1
	TXR2=	LAST2
	UXR=	LAST3
	DXR=	LAST4

	BEG=	LOC
	END=	OFFSET
	LO=	OFSBUF
	HI=	STARSW
	MED=	OP

	FIELD 1		/SET THE FIELD NOW
	*OUDEVH+400	/IT GOES HERE

SORTAB,	0		/FIRST LOC IN PAGE
	TAD	TAGMAX
	CIA
	DCA	TEMP	/TEMP=#CELLS TO SCAN

	/DEFLATE TABLE PRIOR TO SORTING AND LISTING IT
	/OUT WITH EMPTIES AND PERMANENTS

	DCA	HIGHTG	/TARGET POINTER
	DCA	TEMP2	/SOURCE POINTER
DEFLP,	TAD	TEMP2
	DCA	THISTG
	JMS I	PFINDTG	/GET THE NEXT STAB CELL
	TAD	TAG1
	CLL RAL
	SNA SZL CLA	/AND THERE BUT NOT FIXED?
	JMP	DEFNUL	/NO, DON'T STORE IT
	TAD	O1777	/YES,DISCARD THE TYPE BITS NOW
	AND	TAG1
	DCA	TAG1
	AC3777
	AND	TAG2
	DCA	TAG2
	AC3777
	AND	TAG3
	DCA	TAG3
	TAD	HIGHTG
	DCA	THISTG
	JMS I	PPUTTAG
	ISZ	HIGHTG
DEFNUL,	ISZ	TEMP2
	ISZ	TEMP	/TRY AGAIN
	JMP	DEFLP
	JMS I	(SORT	/NOW SORT THEM
	JMP I	SORTAB	/EXIT TO PRTSTAB
	/MOVE A SYMBOL THRU THE TABLE

SMOV,	0
	TAD	SXR2	/GET SOURCE DF+XREG
	JMS	GETFLD
	DCA	SMVCD1
	TAD	TXR
	DCA	SXR
	TAD	TXR2
	JMS	GETFLD
	DCA	SMVCD2
	TAD	O7774
	DCA	SSWT
SMVCD1,	0
	TAD I	SXR
SMVCD2,	0
	DCA I	TXR
	ISZ	SSWT
	JMP	SMVCD1
SMVCD0,	CDF
	JMP I	SMOV

	/AUXILLIARY FIELD+XREG SETTER

GETFLD,	0
	CLL
	TAD I	(USROFS	/IF KEEPING USR
	DCA	TXR	/AC=SYM NUM
	DCA	SMVCD2
	TAD	TXR
	ISZ	SMVCD2
	CML
	TAD	(-1740
	SNL
	JMP	.-4
	CLL RTL
	TAD	(-202	/SETS AS IN SETFLD...
	DCA	TXR	/TENTATIVELY SET TXR
	TAD	SMVCD2
	CLL RTL
	RAL
	TAD	SMVCD0
	JMP I	GETFLD	/EXIT WITH AC SET TO CDF INSTR
	/ROUTINE TO EXCHANGE SYMBOLS LO AND HI

SSWT,	0
	TAD	HI
	JMS	GETFLD
	DCA	SWCDF1
	TAD	SWCDF1
	DCA	SWCDF3
	TAD	TXR
	DCA	SXR
	TAD	SXR
	DCA	SXR2	/SXR'S FOR HIGH SYMBOL
	TAD	LO
	JMS	GETFLD
	DCA	SWCDF2
	TAD	TXR
	DCA	TXR2	/TXR'S FOR LOW SYMBOL
	TAD	O7774
	DCA	SMOV	/COUNTER

SWCDF1,	0
	TAD I	SXR	/GET HI SYM WORD
	DCA	GETFLD	/HOLD IT
SWCDF2,	0
	TAD I	TXR	/GET LO
	DCA	SCOM	/HOLD IT
	TAD	GETFLD
	DCA I	TXR2	/STORE  HI IN LOW
SWCDF3,	0
	TAD	SCOM	/NOW STORE LO
	DCA I	SXR2	/IN HI
	ISZ	SMOV
	JMP	SWCDF1+1
	CDF
	JMP I	SSWT
	/COMPARE SYMBOLS + SET LINK THEREBY

SCOM,	0
	DCA	THISTG	/AC=TAG #
	JMS I	(SETFLD
	TAD I	TAGXR
	CLL CIA
	TAD	TAG1
	SZA CLA
	JMP	SCOMRT
	TAD I	TAGXR
	CLL CIA
	TAD	TAG2
	SZA CLA
	JMP	SCOMRT
	TAD I	TAGXR
	CLL CIA
	TAD	TAG3
	SNA CLA
	HLT	/NEVER
SCOMRT,	CDF
	JMP I	SCOM

	PAGE








	/SORT ROUTINE HERE

SORT,	0
	DCA	BEG	/INITIALIZE PARTITION BOUNDS
	STA STL
	TAD	HIGHTG
	DCA	END	/ARE THERE ANY SYMBOLS?
	SZL
	JMP I	SORT	/NO EXIT WITH LINK SET
	TAD	(LITBF1-1+26	/OK, SET STACK NOW
	DCA	DXR
	TAD	DXR
	DCA	UXR

SLOOP,	STA
	TAD	LEVEL
	DCA	LEVEL
SLOOP2,	TAD	BEG
	STL CIA
	TAD	END
	SNA SZL
	JMP	OKCOOL	/END.LOS.BEG
	CLL RAR
	TAD	BEG
	DCA	MED	/MED=BEG+(END-BEG)/2
	TAD	MED
	DCA	THISTG
	JMS I	PFINDTG	/T=A(MED)
	TAD	BEG
	DCA	LO	/LO=BEG
	TAD	END
	DCA	HI	/HI=END
	TAD	MED
	CIA
	TAD	BEG
	SNA CLA
	JMP	JUSTWO	/BEG.EQ.MED
	TAD	LO
	DCA	SXR2
	TAD	MED
	DCA	TXR2
	JMS I	(SMOV	/A(MED)=A(LO)
BEGLP,	ISZ	LO
	TAD	LO
	CLL CIA
	TAD	HI
	SNL CLA
	JMP	DONE	/HI.LOS.LO
	TAD	LO
	JMS I	(SCOM	/T.GT.A(LO) TO LINK
	SZL CLA
	JMP	BEGLP	/T.GT.A(LO)
	JMP	ENDGO	/T.LT.A(LO)
ENDLP,	TAD	LO
	CLL CIA
	TAD	HI
	SNL CLA
	JMP	DONE	/IF HI.LO.LO
ENDGO,	TAD	HI
	JMS I	(SCOM
	SZL CLA
	JMP	SWITCH
	STA
	TAD	HI
	DCA	HI
	JMP	ENDLP
SWITCH,	JMS I	(SSWT
	STA
	TAD	HI
	DCA	HI
	JMP	BEGLP
DONE,	TAD	HI
	DCA	SXR2
	TAD	BEG
	DCA	TXR2
	JMS I	(SMOV	/A(BEG)=A(HI)
	TAD	HI
	DCA	THISTG
	JMS I	PPUTTAG	/A(HI)=T
	AC7776
	TAD	UXR
	DCA	UXR
	TAD	UXR
	DCA	DXR
	TAD	HI
	CLL CIA
	TAD	MED
	SZL CLA
	JMP	HIBIGR	/DEFER HIGH FOR LATER
	TAD	BEG
	DCA I	DXR	/DEFER LO FOR LATER
	STA
	TAD	HI
	DCA I	DXR
	TAD	HI
	IAC
	DCA	BEG
	JMP	SLOOP
HIBIGR,	TAD	HI
	IAC
	DCA I	DXR
	TAD	END
	DCA I	DXR
	STA
	TAD	LEVEL	/CLUMSY
	DCA	LEVEL
	CLL STA
	TAD	HI
	DCA	END
	SNL		/PROTECT AGAINST WRAP AROUND
	JMP	OKCOOL
	JMP	SLOOP2

JUSTWO,	TAD	HI
	JMS I	(SCOM
	SZL CLA
	JMS I	(SSWT	/SWITCH IF T.GT.A(HI)
OKCOOL,	CLA CLL		/NOW CONSIDER PREV PARTITIONS
	TAD I	UXR
	DCA	BEG
	TAD I UXR
	DCA	END
	ISZ	LEVEL
	JMP	SLOOP2	/REITERATE
	JMP I	SORT	/DONE, RETURN WITH A CLEAR LINK
LEVEL,	0
	PAGE
	>
	/ROUTINE TO STORE THE DATE OF THE FORM DD-MMM-YY
	/IN THE HEADING

	IFZERO	HASH	<
	FIELD	1
	*OUDEVH+400
	>

FMTDAT,	0
	TAD I	(MDATE	/PICK UP THE DATE WORD OF THE FORM MMM MDD DDD YYY
	CDF		/RUN WITH DF = 0
	SNA
	JMP	NODATE	/EXIT IF NO DATE
	DCA	DATWD	/ELSE STORE DATE WORD
	TAD	("0-1
	DCA I	DATPTR	/SET FIRST DIGIT OF DAY
	TAD	DATWD	/NOW GET DAY BITS
	CLL RTR
	RAR
	AND	(37
	JMS	DIV10	/DO DAY DIGITS NOW
	TAD	("-
	DCA I	DATPTR	/STORE DASH
	ISZ	DATPTR
	TAD	DATWD	/NOW GET MONTH BITS
	TAD	(7400	/REDUCE TO ORIGIN 0
	AND	(7400
	CLL RTL
	RTL
	RAL
	DCA	DIV10
	TAD	DIV10
	CLL RAR		/GENERATE 1.5*MONTH INDEX
	TAD	DIV10
	TAD	(MONLST	/INDEX MONTH LIST (SIXBIT)
	DCA	MONPTR
	TAD	(-3
	DCA	DIV10	/SET 3 TIMES THRU LOOP
	SZL
	JMP	MONGO	/IF EVEN START AT RIGHT HALF
MONLP,	TAD I	MONPTR
	CLL RTR
	RTR
	RTR
	JMS	MONPUT	/PUT LEFT CHAR
MONGO,	TAD I	MONPTR
	JMS	MONPUT	/PUT RIGHT CHAR
	ISZ	MONPTR
	JMP	MONLP	/LOOP FOR MORE
MONPUT,	0
	TAD	(40
	AND	(77
	TAD	(40	/CONVERT TO 7BIT
	DCA I	DATPTR
	ISZ	DATPTR
	ISZ	DIV10
	JMP I	MONPUT	/RETURN TO UNPACK LOOP
	TAD	("-
	DCA I	DATPTR	/PUT ANOTHER DASH
	ISZ	DATPTR
	TAD	("6
	DCA I	DATPTR	/SETUP YEAR TENS DIGIT FOR DIVIDE
	TAD I	(BIPCCL
	AND	(600	/GET YEAR EXTENSION FROM 600 BITS
	CLL RTR
	RTR
	DCA	DIV10
	TAD	DATWD	/NOW GET YEAR
	AND	(7	/ISOLATE IT
	TAD	DIV10	/ADD EXTENSION
	JMS	DIV10	/UNPACK IT
NODATE,	CIF CDF		/NOW RETURN
	JMP I	FMTDAT

DIV10,	0
	ISZ I	DATPTR
	TAD	(-12
	SMA
	JMP	.-3	/REDUCE MON 10.
	TAD	(12+"0
	ISZ	DATPTR
	DCA I	DATPTR	/STORE LOW DIGIT
	ISZ	DATPTR
	JMP I	DIV10	/--RETURN--

DATPTR,	DATE
DATWD,	0
MONPTR,	0

	PAGE

	$$$$$