/ RALF, V62A
/
/
/
/
/
/
/
//
/
/
/
/
/COPYRIGHT (C) 1974, 1975, 1977
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
/SION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANT OTHER
/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
/AGREES TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/
/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
/EQUIPMRNT COROPATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
/
/
/
/
/
/
/	RELOCATABLE ASSEMBLER FOR OS/8 FORTRAN IV
/
/
/	FPPASM BY HANK MAURER
/	RALF MODS BY JUD LEONARD
/	OS/8 FORTRAN MODS BY RICHIE LARY + MARTY HURLEY
/	NEW DATE ALGORITHUM PUT IN BY ED STEINBERGER
/
/	THE FOLLOWING FORMULA GIVES THE NUM
/	OF USER SYMBOLS:
/	-(FREE+200[BASE8])/6[BASE10]
/	WHERE THE VALUE OF FREE IS FROM THE
/	RALF SYMBOL MAP
/
/
IFNDEF	RALF	<RALF=1	/GO RELOCATABLE THEN>
/
/	ASSEMBLE WITH PAL8-V9 WITH W SWITCH
/	SAVE AS:
/	.SAVE SYS RALF.SV ;200=2000

/
/ CHANGES FOR OS/78 AND OS/8 V3D BY P.T.
/ .CHANGED VERSION NUMBER TO 62
/ .RALF NO LONGER GENERATES FAULTY RELOCATABLE IF:
/  1.) THE ESD IS LONGER THAN ONE BLOCK, AND
/  2.)LIST OUTPUT IS DIRECTED TO A 2-PAGE NON-SYSTEM HANDLER
/
/
	FLD0=0
	FLD1=10
	VNUM=62
	PATCH="A	/PATCH LEVEL A
	*3
VERS,	VNUM	/VERSION NUMBER
OLDN3,	0	/TEMP FOR LOOKUP
OTEMP,	0	/A COUPLE OF TEMPS THAT
OCNT,	0	/DIDNT FIT INTO THEIR PAGE
	0
X10,	0
X11,	0
X12,	0
X13,	0
X14,	0
OUTPTR,	OUBUF-1
NEXT,	FREE-1
CHRPTR,	LINE-1
NCHARS,	-1	/CHARACTER INPUT STUFF
CPTMP,	0
NCTMP,	0	/USED TO SAVE CHAR POSITION
LINSIZ,	0	/SIZE OF LINE FOR PRINTING
STYPE,		/SYMBOL TYPE CODE
CHKSUM,	0	/FOR BINARY OUTPUT
	IFZERO	RALF	<
LOCTR1,	0	/INITIAL LOCN CNTR FOR ABSOLUTE ASM
LOCTR2,	200	>
	IFNZRO	RALF	<
ESDNO,	2	/LAST ESD #. (#MAIN & BLANK COMMON DEFAULT)
LOCTR1,	20	/HIGH LOCN CNTR WITH ESD (STARTS IN #MAIN)
LOCTR2,	0	
DPFLG,	0	>
BASER,	4000	/BASE REGISTER SETTING
	0
INDXR,	0	/INDEX LOCS: MUST FOLLOW BASER
	0
EXPVAL,	0	/EXPRESSION VALUE
	0
	0
EXPDEF,	0	/=0 IF EXPR IS UNDEFINED
EXPSW,	0	/FLAG=1 IF NO EXPR
WORD1,	0	/TEMPORARY 2 WORD OPERAND
WORD2,	0
FPPADR,	0	/ADDRESS FIELD FOR FPP INDEX INSTR
	0
OPCODE,	0	/OPCODE OR PSEUDO-OP POINTER
XFLAG,	0	/INDEX FLAG = 1 IF INDEX PRESENT
XINCR,	1	/FLAG = 0 IF + LEGAL IN INDEX EXPR
BUCKET,	0	/FIRST CHAR OF NAME
NAME1,	0	/CHARS 2 AND 3 OF NAME
NAME2,	0	/CHARS 4 AND 5 OF NAME
NAME3,	0	/CHAR 6 OF NAME AND TYPE
LASTOP,	0	/LAST OPERATOR ENCOUNTERRED IN EXPR
PASSNO,	-1	/PASS NUMBER
ASMOF,	0	/SET NEGATIVE WHEN ASSEMBLY OFF
PNCHOF,	0	/NON-ZERO TO SUPPRESS BINARY OUTPUT
LISTSW,	1	/LIST SWITCH (1 ENABLES LISTING)
OUTSWT,	0	/OUT SWITCH, =1 IF LINE ALREADY LISTED
REPCNT,	0	/REPEAT COUNTER
SCSWT,	0	/SEMICOLON SWITCH
RADIX,	0	/RADIX FOR INTEGERS (0 IS OCTAL)
LTEMP,	-177	/TEMP USED BY LOOKUP
EXTMP,	0	/TEMPS USED BY EXPR AND OTHERS
EXTMP2,	0
EQUN,	0;0;0;0	/NAME ON LEFT OF EQUAL SIGN
		/NEXT TWO LOCS USED WITH EQUN BY DMPESD
FPPSWT,	0	/1 WHHEN FINDING FPP ADR EXPR
FPP2WD,	0	/SET BY EXPR TO FORCE 2 WD FMT
FPPWD2,	0	/SET BY FPP2WD.OR.EXPTYP.EQ.0
LITRL,	0	/SET = 1 FOR LITERAL
P0LIT,	177
CPLIT,	177
PAGEN,	0
ERRORS,	0		/ERROR COUNT
PC,	TTYOUT		/OUTPUT ROUTINE
OUFILE,	7573		/OUTPUT FILE LIST POINTER
BFILE,	1
LPAGE1,	1	/INPUT FORMFEED COUNT
LPAGE2,	0	/OUTPUT PAGE WITH RESPECT TO ABOVE
LINPAG,	-1	/LINES/PAGE COUNTER
LINKSW,	0	/1 IF LINK GENERATED ON THIS LINE
LINKS,		/NO OF LINKS GENERATED
ABREFS,	0	/NO OF ABSOLUTE REFERENCES
ABSOP,	0	/POINTER-SWITCH FOR BINARY OUTPUT
USR,	200	/CURRENT CALL ADDRESS FOR USR
SYONLY,	0	/=0=LIST ONLY SMAP WHEN LIST FILE
		/IS SPECIFIED. ITS SET VIA SLASH S
		/=1=REGULAR
NP17,	17	/**
NP7700,	7700
OPX,	0
OP,	ZBLOCK 6
ACX,	0
AC,	ZBLOCK 6
M3,	-3
BLINE,	LINE-1
/
	PAGE
/
/	CORE ALLOCATION IN HIGH FIELD 0
/
	CPLBUF=5100	/ACTUALLY AT 5200
	P0LBUF=5200	/AND 5300, 1/2 PAGE EACH
	IFZERO	RALF	<
	INBUF=5400	>
	IFNZRO	RALF	<
	INBUF=6000	/AFTER PASS 1, MOVES TO 5400>
	OUBUF=6400
	LINE=7000	/CURRENT INPUT LINE IN ASCII
	INDEVH=7200	/TENTATIVE INPUT DEVICE HANDLR ADDR
	OUDEVH=7400	/TENTATIVE OUTPUT HANDLER ADDR
	INRECS=2
	INCTL=400
	OUCTL=4200
/
/	COLLECT THE NEXT STATEMENT
/
	ISZ	.+2
REPLEN,	JMP I	.+1
REPLST,	BEGIN		/START AT 6000 IF CHAINED ELSE 6001
NEXTST, CDF	FLD0	/JUST PRECAUTION
	TAD	OUTSWT	/IF NO OUTPUT FROM THIS LINE,
	SNA CLA
	TAD	PASSNO	/AND LISTING PASS
	SMA SZA CLA
	TAD	LISTSW	/AND LISTING ENABLED
	SNA CLA		/PRINT THIS LINE NOW
	JMP	START	/ELSE GET NEXT
	JMS I	[CRLF	/PRINT CR/LF
	TAD	(-6
	DCA	LTEMP	/SPACE OVER
	JMS I	[PRINT2 /12 SPACES
	ISZ	LTEMP
	JMP	.-2
	JMS I	(PRNTLN /THEN PRINT LINE
START,	JMS I	[GETCHR /ANY MORE CHARS ?
	JMP	NOTEG
	JMS I	[ERMSG	/EXTRA GARBAGE ON LAST LINE
	0507		/*EG*
NOTEG,	TAD	SCSWT	/DID LAST LINE END WITH SEMICOLON ?
	SNA CLA
	JMP	.+5	/NO
	DCA	SCSWT	/KILL SC SWITCH
	ISZ	CHRPTR	/SKIP OVER SEMICOLON
	ISZ	NCHARS
	JMP	ASMBL	/DON'T READ A NEW LINE
	TAD	REPCNT	/IS THIS LINE TO BE REPEATED?
	SPA CLA
	JMP	AGAIN	/DO IT
NEWLIN, TAD	BLINE /RESET POINTER
	DCA	CHRPTR
	TAD	[-200	/LIMIT LINE SIZE
	DCA	MAXLIN
	DCA	OUTSWT	/CLEAR OUTPUT SWITCH
RDLOOP, JMS I	(ICHAR	/READ A CHAR
	TAD	(-212
	SNA
	JMP	RDLOOP	/IGNORE LINE FEEDS
	TAD	(212-215 /END ON CR
	SNA
	JMP	ENDLIN
	IAC
	SNA		/FORM FEED?
	JMP	FORMFD
	TAD	(214	/FIX CHAR
	DCA I	CHRPTR	/SAVE IT
	ISZ	MAXLIN	/TEST FOR LINE TOO LONG
	JMP	RDLOOP	/PUT CHAR AWAY AND GET NEXT 1
	JMS I	(ICHAR	/IGNORE ANOTHER CHAR
	TAD	(-215	/UNLESS CR
	SZA CLA
	JMP	.-3
	JMS I	[ERMSG	/EXCESS LENGTH LINE
	1424		/*LT*
ENDLIN, TAD	CHRPTR	/FIND - NUMBER OF CHARS - 1
	CMA
	TAD	BLINE
	DCA	NCHARS
	TAD	REPCNT	/0 BECOMES 0,
	CIA		/BUT POS REP COUNT
	DCA	REPCNT	/ENABLES REPEAT
	TAD	NCHARS	/SAVE LENGTH
	DCA	REPLEN
	TAD	LISTSW	/SAVE LISTING SWITCH DURING REPEAT
	DCA	REPLST
REASM,	TAD	NCHARS	/SAVE SIZE OF LINE FOR PRINT
	DCA	LINSIZ
	TAD	BLINE
	DCA	CHRPTR	/SET POINTER
ASMBL,	TAD	ASMOF	/ARE WE INSIDE A CONDITIONAL
	SZA CLA
	JMP	OFFIT	/YES, AND THE COND WAS FALSE
	JMS I	[GETCHR /LOOK FOR A CHARACTER
	JMP	NEXTST
	TAD	(-257	/IS IT SLASH ?
	SNA
	JMP	NOASM	/YES, COOL IT
	TAD	[257-240 /IS IT BLANK OR TAB ?
	SZA CLA		/YES, IGNORE
	JMS I	[BACK1	/NO, PUT IT BACK
	JMP I	(LUNAME /ASSEMBLE STMT
FORMFD,	ISZ	LPAGE1	/BUMP FORM FEED COUNT
	DCA	LPAGE2	/CLEAR SUB-PAGE COUNT
	CLA CMA
	DCA	LINPAG	/FORCE EJECT ON CRLF
	JMP	RDLOOP
OPENIT,	CLA CMA		/DECR COUNT, ANOTHER OPEN ANGLE
	TAD	ASMOF
	DCA	ASMOF
OFFIT,	ISZ	NCHARS	/MORE TO GO?
	JMP	GETIT	/YES
NOASM,	CLA CMA
	DCA	NCHARS	/DONT ASSEMBLE THIS LINE
	JMP	NEXTST	/(PREVENTING *EG* MESSAGE)
GETIT,	TAD I	CHRPTR	/PICK UP THE CHARACTER
	TAD	(-274	/OPEN ANGLE BRACKET?
	SNA
	JMP	OPENIT	/YES, PUSH ONE LEVEL DOWN
	CLL RTR
	SNA CLA
	ISZ	ASMOF	/IF CLOSE, CHECK LEVEL
	JMP	OFFIT	/TRY FOR NEXT
	JMP	ASMBL	/RESUME WORK
AGAIN,	TAD	REPLEN	/WE NOW REPEAT THE SAME LINE
	DCA	NCHARS
	DCA	LISTSW	/NO LISTING DURRING REPEAT
	ISZ	REPCNT
	JMP	REASM	/ASSUMING COUNT STILL OK
	TAD	REPLST	/RESTORE LISTING
	DCA	LISTSW
	JMP	NEWLIN	/GET NEXT LINE
	MAXLIN=LTEMP
/
TXERR,	TEXT	" ERRORS"
TXELN=	.-TXERR
	PAGE
/
/	DIVIDE AC BY 3
/	USEFUL IN FPP REFERENCES TO BASE
/
OVER3,	0		/DIVIDE AC BY THREE
	DCA	EXTMP2	/MQ
	TAD	(-15	/SET SHIFT COUNT
	DCA	LTEMP
DIVLUP,	CLL		/ZERO LINK
	TAD	(-3	/SUBTRACT DIVISOR FROM AC
	SZL		/IF AC>=3 SET LINK TO 1
	JMP	.+3	/OK, DONT RESTORE
	TAD	(3	/TOO SMALL, RESTORE AC
	CLL		/SET LINK BACK TO 0
	DCA	EXTMP	/SAVE AC
	TAD	EXTMP2	/ROTATE MQ-AC LEFT, PUT LINK IN MQ
	RAL
	DCA	EXTMP2	/SAVE MQ
	TAD	EXTMP	/GET BACK AC
	RAL		/COMPLETE SHIFT
	ISZ	LTEMP	/TEST COUNT
	JMP	DIVLUP	/KEEP GOING
	DCA	EXTMP	/THIS IS REMAINDER
	TAD	EXTMP2	/RETURN QUOTIENT
	JMP I	OVER3
/
/	INITIALIZE FOR OUTPUT
/
OUSETP,	0
	TAD	(OUCTL&3700	/BUFFER SIZE IN DBL WORDS
	CIA		/NEGATE IT (PAL10 BLOWS)
	DCA	OUDWCT
	TAD	NOUBUF
	DCA	OUPTR	/INITIALIZE WORD POINTER
	TAD	OUJMPE
	DCA	OUJMP	/INITIALIZE 3-WAY CHARACTER SWITCH
	JMP I	OUSETP
NOUBUF,	OUBUF
/
/	STORE CHARACTERS IN OUTPUT BUFFER
/	IN PS8 FORMAT (YOU KNOW, 3 CHARS
/	IN 2 WORDS THE WRONG WAY)
/
OCHAR,	0
	AND	(377
	DCA	OUTEMP
	TAD	OUTINH
	SZA CLA		/IS THERE AN OUTPUT FILE?
	JMP I	OCHAR	/NO - EXIT
	CDF OUFLD	/SET DATA FIELD TO BUFFER'S FIELD
	ISZ	OUJMP	/BUMP THE CHARACTER SWITCH
OUJMP,	HLT		/THREE WAY CHARACTER SWITCH
	JMP	OCHAR1
	JMP	OCHAR2
	TAD	OUTEMP
	CLL RTL
	RTL
	AND	(7400
	TAD I	OUPOLD
	DCA I	OUPOLD	/UPDATE FIRST WORD OF TWO WITH HIGH
			/ORDER 4 BITS OF THIRD CHAR
	TAD	OUTEMP
	CLL RTR
	RTR
	RAR
	AND	(7400
	TAD I	OUPTR
	DCA I	OUPTR	/UPDATE 2ND WORD FROM LO 4 BITS
	TAD	OUJMPE
	DCA	OUJMP	/RESET SWITCH
	ISZ	OUPTR
	ISZ	OUDWCT	/BUMP COUNTER EVERY 3 CHARS
	JMP	OUCOMN
	TAD	(OUCTL	/LOAD CONTROL WORD FOR A FULL WRITE
	JMS I	(OUTDMP	/DUMP THE BUFFER
	JMS	OUSETP	/RE-INITIALIZE THE POINTERS
	JMP	OUCOMN
OCHAR2,	TAD	OUPTR
	DCA	OUPOLD	/SAVE POINTER TO FIRST WORD OF TWO
	ISZ	OUPTR	/BUMP WORD POINTER TO SECOND WORD
OCHAR1,	TAD	OUTEMP
	DCA I	OUPTR
OUCOMN,	CDF
	JMP I	OCHAR
OUTEMP,	0
OUPOLD,	0
OUPTR,	0
OUJMPE,	JMP	OUJMP
OUDWCT,	0
OUTINH,	0
/
/	MOVE OUTPUT FILE NAME TO FIELD 0
/
OFNAME,	0
	TAD	OUFILE
	DCA	X10
	TAD	(OUFNAM-1
	DCA	X11
	TAD	(-4
	DCA	LTEMP
	CDF	10
	TAD I	X10
	CDF	0
	DCA I	X11
	ISZ	LTEMP
	JMP	.-5
	JMP I	OFNAME
/
/	GET OUTPUT DEVICE CHARISTICS
/
OTYPE,	0
	CDF	10
	TAD I	(7600
	AND	[17
	TAD	(DCB-1
	DCA	OTYPP
	TAD I	OTYPP
	CDF	0
	JMP I	OTYPE
OTYPP=	OFNAME
/
/	BASIC TITLE INFO
/
TITBUF,
	IFZERO	RALF	<
	TEXT	"FLAP V"	>
	IFNZRO	RALF	<
	TEXT	"RALF V"	>
*.-1
VMTXT,	0;0;0
TITDAT,	ZBLOCK	6
	TEXT	" PAGE"
TITLEN=	.-TITBUF
	PAGE
/
/	PROCESS A STATEMENT
/
LUNAME, TAD	CHRPTR	/SAVE CHAR STUFF
	DCA	CPTMP
	TAD	NCHARS
	DCA	NCTMP
	DCA	LINKSW	/CLEAR SWITCH
	JMS I	[GETNAM /LOOK FOR NAME
	IFZERO	RALF	<
	JMP I	(TRYSTR	/COULD BE AN ORG>
	IFNZRO	RALF	<
	JMP I	(GETEXP	/NOT ONE OF OURS, I GUESS>
	JMS I	[GETCHR /LOOK FOR COMMA
	JMP	JSTONE	/ITS JUST ONE SYMBOL
	TAD	(-254	/COMMA TEST
	SZA
	JMP	TRYEQU	/NO COMMA, CHECK FOR EQUAL
	JMS I	[LOOKUP /LOOK UP SYMBOL
	JMP	DEFLBL	/ITS UNDEFINED
	CLL RAR		/VERIFY ADDR TYPE
	SZA CLA
	JMP	MDERR	/THAT'S A NO-NO
	TAD I	X10	/CHECK LOCCTR AGAINST OLD DEFINITION
	CIA
	TAD	LOCTR1	/FIRST UPPERR HALF
	SZA CLA
	JMP	.+6
	TAD I	X10
	CIA
	TAD	LOCTR2	/THEN LOWER HALF
	SNA CLA
	JMP	DEFIND
MDERR,	JMS I	[ERMSG	/MULTIPLY DEFINED
	1504		/*MD*
	JMP I	(ASMBL	/FIELD IS OK
DEFLBL, ISZ I	LTEMP	/SET TYPE TO 1 (USER ADDR)
	TAD	LOCTR1	/PUT LOCATION COUNTER
	DCA I	X10	/INTO VALUE
	TAD	LOCTR2
	DCA I	X10
DEFIND, CDF	FLD0	/GO LOOK FOR ANOTHER TAG
	JMP I	(ASMBL
TRYEQU, TAD	(-21	/CHECK FOR EQUAL SIGN
	SZA
	JMP	TRYBLK	/NO, TRY BLANK
	TAD	NAME1
	DCA	EQUN	/SAVE 6 CHARACTER NAME
	TAD	NAME2
	DCA	EQUN+1
	TAD	NAME3
	DCA	EQUN+2
	TAD	BUCKET
	DCA	EQUN+3
	JMS I	[GETCHR /ALLOW BLANK AFTER =
	JMP	EQUERR
	TAD	[-240
	SZA CLA
	JMS I	[BACK1	/ANYTHING ELSE GOES BACK
	JMS I	[EXPR	/GET VALUE RIGHT OF EQUALS
	JMP	EQUERR	/BAD EQU
	TAD	EQUN	/RESTORE NAME
	DCA	NAME1
	TAD	EQUN+1
	DCA	NAME2
	TAD	EQUN+2
	DCA	NAME3
	TAD	EQUN+3
	DCA	BUCKET
	JMS I	[LOOKUP /LOOKUP SYMBOL
	JMP	PUTVAL	/A NEW SYMBOL
	CLL RAR
	SZA CLA
	JMP	EQUERR	/TYPE CONFLICT
PUTVAL, TAD	EXPVAL+1 /SAVE ADDRESS TYPE
	DCA I	X10
	TAD	EXPVAL+2
	DCA I	X10
	TAD I	LTEMP	/NOW GET TYPE WORD
	AND	(7740	/ZERO OLD TYPE, PRESERVING FORCE BIT
	TAD	EXPDEF	/DEFINED BY RIGHT HAND SIDE
	DCA I	LTEMP	/RESTORE WORD
	CDF	FLD0
	JMP I	[NEXTST /GO GET NEXT STMT
EQUERR, JMS I	[ERMSG	/BAD EQU
	0205		/*BE*
	JMP I	[NEXTST
TRYBLK,	TAD	(35	/CHECK FOR BLANK
	SNA		/MATCH BLANK?
	JMP	JSTONE	/YES
	AND	[77
	JMS I	[R6L
	DCA	NAME3	/MAKE MODIFIED NAME OF IT
	JMS I	[GETCHR	/MODIFIER MUST BE FOLLOWED BY BLANK
	JMP I	(GETEXP	/LOOKS BAD
	TAD	[-240	/GOT IT?
	SZA CLA
	JMP I	(GETEXP	/LET EXPR TELL HIM IF ITS WRONG
JSTONE,	TAD	(33	/USE OUR INTERNAL SYMBOL TABLE
	JMS I	[FIND	/IS IT THERE?
	JMP I	(GETEXP	/NO, LOOK IN USER'S
	TAD	OPCTBL	/CREATE JUMP THRU TABLE
	DCA	OPCJMP	/SAVE IT
	TAD I	X10	/PICK UP FIRST WORD OF VALUE
	DCA	OPCODE	/ITS AN OPCODE-MAYBE?
	CDF	FLD0
OPCJMP,	0		/JUMP SOMEWHERE
OPCTBL,	JMP I	.-4
	PSEUDO		/PSEUDO OPS
	PDP8MR		/PDP8 MRI
	FPPMR		/FPPMR
	FPPS1		/OTHER FPP OPCODES
	FPPS2
	FPPS3
	FPPS4
	FPPS5
	FPMRI		/INDIRECT FPP MEM REF
	FPMRS		/SHORT DIRECT MEM REF
	FPMRL		/LONG DIRECT REF
	PDPOPR		/8-MODE OPERATES
REPETX,	JMS I	(ADRGET	/EVALUATE REPEAT EXPR
	CLL CMA RAR	/3777
	AND	EXPVAL+2
	DCA	REPCNT
	JMP I	[NEXTST
	PAGE
/
GETEXP, CDF	FLD0
	TAD	CPTMP	/RESTORE CHARACTER POINTER
	DCA	CHRPTR
	TAD	NCTMP	/TO JUST AFTER TAG (IF ANY)
	DCA	NCHARS
SX,	DCA	OPCODE
	JMS I	[EXPR	/TRY FOR AN EXPRESSION
	JMP	BADEXP	/IF NONE, ERROR
	IFNZRO	RALF	<
	JMS	RELERR	/BOMB IF NOT ABSOLUTE EXP>
	TAD	EXPVAL+2
	JMS I	[OUTWRD
	JMP I	[NEXTST /GO DO NEXT STMT
	IFNZRO	RALF	</IF EXPVAL IS RELOCATABLE,
RELERR, 0		/GIVE ERROR MESSAGE
	TAD	EXPVAL+1 /CAUTION: THIS ROUTINE IS
			/SOMETIMES CALLED WITH NON-ZERO AC
	AND	[7770	/JUST ESD BITS
	SNA CLA
	JMP I	RELERR	/ITS ABSOLUTELY FINE
	TAD	EXPVAL+1
	AND	[7	/REMOVE ESD
	DCA	EXPVAL+1
	JMS I	[ERMSG
	2205		/*RE*
	JMP I	RELERR	>
/
FPPMR,	ISZ	FPPSWT	/SET FORCE ENABLE
	JMS	FPADR
	TAD	WORD1	/IF WAY OFF BASE,
	SNA
	TAD	FPPWD2	/OR IF FORCED
	SNA
	TAD	XFLAG	/OR IF INDEXED
	SZA CLA
	JMP	FORMT1	/USE LONG FORM
	TAD	WORD2
	CLL
	TAD	(-600	/COMPLETE OFF-BASE CHECK
	SZL CLA
	JMP	FORMT1	/USE LONG
	JMP	FORMT2
FPPS2,	JMS I	(GETADR /COLLECT ADDRESS EXPR
	JMS	IXMES	/BUT DISALLOW INDEX
	JMP	F2WD	/PUT TWO WORDS OUT
/
IXMES,	0
	TAD	XFLAG	/NO INDEX ALLOWED
	SNA CLA
	JMP I	IXMES	/HE'S COOL
	JMS I	[ERMSG
	1130		/*IX*
	JMP I	IXMES
FPMRL,	JMS	FPADR
FORMT1, JMS I	(FIXOPC
F2WD,	TAD	FPPADR
	AND	[7	/FIELD BITS
	TAD	OPCODE	/IN FIRST WORD
FPDMP,	IFZERO	RALF	<
	JMS I	[OUTWRD
	TAD	FPPADR+1 /LOW ADDRESS
	JMS I	[OUTWRD
	JMP I	[NEXTST /NEXT!>
	IFNZRO	RALF	<
	JMP I	(OUTREL /DUMP TWO RELOCATABLE>
FPMRS,	JMS	FPADR	/COLLECT OPERAND
	JMS	IXMES	/ERROR IF INDEX GIVEN
	TAD	WORD1
	SZA CLA
	JMP	BADEXP
	TAD	WORD2
	CLL
	TAD	(-600	/DOES IT FIT?
	SNL CLA
	JMP	FORMT2
BADEXP, JMS I	[ERMSG
	0230		/*BX*
	TAD	OPCODE	/BEST GUESS OF THE DESIRED OUTPUT
	JMS I	[OUTWRD
	JMP I	[NEXTST
FPMRI,	JMS	FPADR
	TAD	WORD1
	SZA CLA
	JMP	BADEXP	/NOT EVEN CLOSE
	TAD	WORD2
	CLL
	TAD	(-30
	SZL CLA
	JMP	BADEXP	/GOTTA BE IN THE FIRST 10
FORMT3, JMS I	(FIXOPC
FORMT2, TAD	WORD2
	JMS I	(OVER3	/BY 3 FOR BASE ADDRESS
	TAD	[200
FPPS3,	TAD	OPCODE
	JMS I	[OUTWRD /WHEW!
	JMP I	[NEXTST
FPPS1,	JMS I	(GETADR /GET ADDR, AND INDEX
	JMS I	(FIXOPC /PUT OPCODE TOGETHER
	TAD	FPPADR	/GET ADDR EXTENSION
	AND	[7
	TAD	OPCODE	/WITH TOGETHER OPCODE
	AND	(7377	/WITHDRAW ONE BIT
	JMP	FPDMP	/PUT IT OUT
FPPS5,	CLA IAC		/DISALLOW INDEX INCR
	JMS I	(GETADR	/COLLECT ADDRESS AND INDEX
	IFNZRO	RALF	<
	TAD	FPPADR
	AND	[7770	/MUST BE ABSOLUTE
	SNA CLA
	JMP	.+3	/OK
	JMS I	[ERMSG
	2205		/*RE*>
	TAD	XFLAG
	SZA CLA		/ANY INDEX?
	TAD	EXPVAL+2
	AND	[7	/STRIP OFF ESD BITS
	TAD	OPCODE
	JMS I	[OUTWRD	/DUMP THAT
	TAD	FPPADR+1
	JMS I	[OUTWRD	/NOW LOW 12 BITS
	JMP I	[NEXTST
/
FPADR,	0
	JMS I	(GETADR	/COLLECT ADDRESS AND INDEX
	TAD	BASER+1
	CIA STL
	TAD	FPPADR+1
	DCA	WORD2	/GET ADDRESS RELATIVE TO BASE
	RAL
	TAD	BASER
	CIA
	TAD	FPPADR
	DCA	WORD1
	JMP I	FPADR
	PAGE
/
PSEUDO,	JMP I	OPCODE	/DISPATCH TO APPROPRIATE HNDLR
/
	IFZERO	RALF	<
/
/	ASSEMBLE VARIOUS INSTRUCTION TYPES
/
PDP8MR,	TAD	CHRPTR	/SAVE POSITION
	DCA	CPTMP
	TAD	NCHARS
	DCA	NCTMP	/SAVE COUNT
	JMS I	[GETCHR	/LOOK FOR SPACE "I"
	JMP	GETMR	/WILL GIVE BX ERROR
	TAD	(-"I	/IS IT I?
	SNA CLA		/IF NOT, FORGET IT
	JMS I	[GETCHR	/MUST BE FOLLOWED BY SPACE
	JMP	NOTIND
	TAD	[-240
	SZA CLA
	JMP	NOTIND	/SOMETHING ELSE
	TAD	OPCODE	/PUT INDIRECT INTO OPCODE
	TAD	(400
	DCA	OPCODE
GETMR,	JMS	ADRGET	/PICK UP ADDRESS FIELD
	TAD	EXPVAL+2 /CHECK PAGE OF ADDRESS
	AND	[7600
	SNA
	JMP	PAGEZ	/ITS IN PAGE 0
	CIA
	TAD	LOCTR2	/COMPARE WITH CURRENT PAGE
	AND	[7600
	SNA CLA
	JMP	THSPAG	/OK, ITS THIS PAGE
	TAD	OPCODE	/CAN WE USE A LINK ?
	AND	(400	/IS INDIRECT BIT OFF ?
	SNA CLA
	JMP I	(MAKLNK /YES, GO MAKE LINK
	JMS I	[ERMSG	/NOPE, ITS AN ILLEGAL REFERENCE
	1122		/*IR*
THSPAG, TAD	EXPVAL+2 /GET ADDRESS
	AND	[177	/LOWER 7 BITS
	TAD	[200	/PUT IN PAGE BIT
	SKP
PAGEZ,	TAD	EXPVAL+2 /GET ADDRESS (UPPER 5 BITS ZERO)
	TAD	OPCODE	/PLUS OPCODE
	JMS I	[OUTWRD /OUTPUT WORD
	JMP I	[NEXTST
NOTIND,	TAD	CPTMP	/RESTORE CHAR POINTER
	DCA	CHRPTR
	TAD	NCTMP
	DCA	NCHARS
	JMP	GETMR	/NOT AN INDIRECT>
FPPS4,	JMS	ADRGET	/GET INDEX REG EXPRESSION
	IFZERO	RALF	<
	JMS	LITERR	/CAN'T ALLOW LITERAL>
	JMS	SUBX	/GET RELATIVE INDEX VALUE
	TAD	EXPVAL+2 /GET LOWER 3 BITS
	AND	[7	/OF INDEX REG EXPR
	TAD	OPCODE	/WITH OPCODE
	JMS I	[OUTWRD /OUT
	JMP I	[NEXTST
ADRGET, 0		/GET ADDRESS EXPR AND CHECK TYPE
	JMS I	[EXPR	/GET EXPR
	JMS I	[ERMSG	/BAD ADDR EXPR
	0230		/*BX*
	JMP I	ADRGET
	IFZERO	RALF	<
LITERR,	0		/GIVE ERROR IF LITERAL
	TAD	LITRL
	SNA CLA
	JMP I	LITERR
	JMS I	[ERMSG
	1114		/*IL*
	JMP I	LITERR	>
	IFNZRO RALF <
PDP8MR,	JMS	ADRGET
	JMP I	(CHCKMR	/V.56
	>
GETADR,	0		/GET ADDR, INDEX
	DCA	XITEMP	/SAVE INDEX INCREMENT SWITCH
	JMS	ADRGET	/GET ADDR
	DCA	FPPSWT	/KILL FPP SWITCH
	IFZERO	RALF	<
	JMS	LITERR	/DISALLOW LITERALS>
	TAD	EXPDEF	/IF EXPR WAS UNDEFINED
	SNA CLA
	IAC		/OR FORCE BIT WAS SET
	TAD	FPP2WD
	DCA	FPPWD2	/FORCE 2 WORD FORMAT
	DCA	XFLAG	/ZERO INDEX SWT
	TAD	EXPVAL+1	/SAVE ADDRESS VALUE
	DCA	FPPADR
	TAD	EXPVAL+2
	DCA	FPPADR+1
	JMS I	[GETCHR	/LOOK FOR COMMA
	JMP I	GETADR	/NO INDEX
	TAD	(-254
	SZA CLA
	JMS I	[BACK1	/WILL CAUSE A BX ERROR
	ISZ	XFLAG	/SET INDEX SWITCH
	TAD	XITEMP	/SET INDEX INCREMENT SWITCH
	DCA	XINCR
	JMS	ADRGET
	ISZ	XINCR	/CLEAR INDEX INCREMENT SWITCH
	IFZERO	RALF	<
	JMS	LITERR	>
	JMS	SUBX	/CALCULATE INDEX NO
	JMP I	GETADR
XITEMP,
SUBX,	0
	TAD	INDXR+1	/CHECK FOR INDEX IN RANGE
	STL CIA
	TAD	EXPVAL+2
	DCA	EXPVAL+2
	RAL
	TAD	INDXR
	CIA
	TAD	EXPVAL+1
	SZA CLA
	JMP	BIERR
	TAD	EXPVAL+2
	CLL
	TAD	[-10
	SZL CLA
BIERR,	JMS I	[ERMSG
	0211		/*BI*
	JMP I	SUBX
	IFNZRO	RALF	<
/
/	AT END OF PASS,
/	CLEAR LENGTHS OF ALL SECTIONS
/
CLRSCT,	0
	TAD	(PNDL+3
	DCA	LTEMP	/POINT TO USER SYMBOL SPACE
	CDF	FLD1
CSLOOP,	TAD I	LTEMP	/GET TYPE
	AND	[37	/STRIP TO TYPE ONLY
	TAD	(-3
	SPA CLA		/IS IT COMMON OR SECTION?
	JMP	NOTSCT	/NO, PASS IT
	ISZ	LTEMP	/BUMP POINTER TO VALUE
	TAD I	LTEMP
	AND	[7770	/SAVE ESD NUMBER
	DCA I	LTEMP
	ISZ	LTEMP
	DCA I	LTEMP	/CLEAR LOW ORDER
	CLA CLL CMA RAL	/-2
NOTSCT,	TAD	(6	/BUMP POINTER
	TAD	LTEMP	/TO NEXT SYMBOL
	DCA	LTEMP
	TAD	NEXT	/COMPARE END OF SYMBOL TABLE
	CIA CLL
	TAD	LTEMP
	SNL CLA
	JMP	CSLOOP	/MORE TO GO
	CDF	FLD0
	JMP I	CLRSCT	/THAS ALL>
/
/
	IFNZRO RALF	<
/
/	ENSURE BOTH SYMBOL AND SUB-EXPR ARE ABSOLUTE
/
NOREL,	0
	TAD	WORD1	/IS SYMBOL RELOCATABLE?
	AND	[7770	/TEST ESD BITS
	SZA CLA
	STL RAR		/IF SO, FORCE ERROR
	JMS I	(RELERR	/TEST SUB EXPR
	JMP I	NOREL
DPCHKX,	CLA CLL CML RAR	/SET DPFLG, MODULE NEEDS
	DCA DPFLG	/DP HARDWARE
	JMP I [NEXTST	
/	SET BASE AND INDEX LOCS
INDXX,	CLA STL RTL	/INDXR MUST JUST FOLLOW BASER
BASEX,	TAD	(BASER-1	/POINT TO VALUE TO BE SET
	DCA	X12	/HOPEFULLY UNUSED XR
	JMS I	(ADRGET	/COLLECT EXPRESSION
	TAD 	EXPVAL+1
	DCA I	X12	/HIGH ORDER AND ESD
	TAD	EXPVAL+2
	DCA I	X12	/LOW ORDER
	JMP I	[NEXTST	>/THIS CONDITIONAL SASSEMBLY WAS
/EXPANDED TO INCLUDE INDXX ON THIS PAGE. IT IS ALSO 
/COND. ASSEMBLED ON ANOTHER PAGE FOR FLAP.
DELFIL,	0
	TAD	[7600
	DCA	OUFILE
	JMS I	[OFNAME
	CLA IAC
	CIF	10
	JMS I	USR
	4
	OUFNAM
	0
	NOP
	JMP I	DELFIL
	PAGE
/
/	PRINT THE CURRENT LINE IF NOT ALREADY DONE
/
PRNTLN,	0		/PRINT THE LINE
	TAD	OUTSWT	/HAS THE LINE BEEN PRINTED YET?
	SZA CLA
	JMP I	PRNTLN	/YES, COOL IT
	ISZ	OUTSWT	/SET SWITCH
	TAD	BLINE	/POINTER TO LINE
	DCA	X13
	DCA	CRLF	/CLEAR POSITION COUNT
	JMP	PRLTST	/IN CASE OF EMPTY LINE
PRLNXT,	TAD I	X13	/GET A CHAR
	TAD	(-211	/WATCH OUT FOR TAB
	SNA
	JMP	TABIT	/CONVERT TO BLANKS
	TAD	(211	/RESTORE
	ISZ	CRLF	/BUMP POSITION COUNT
	JMS I	PC	/PRINT IT
PRLTST,	ISZ	LINSIZ	/CHECK COUNT
	JMP	PRLNXT
	JMP I	PRNTLN
TABIT,	TAD	[240	/REPLACE TAB WITH BLANKS
	ISZ	CRLF
	JMS I	PC
	TAD	CRLF
	AND	[7
	SZA CLA
	JMP	TABIT
	JMP	PRLTST
/
/	GO TO NEXT LINE
/
CRLF,	0
	CLA
	TAD	(215
	JMS I	PC	/PRINT A CHAR
	TAD	(212
	JMS I	PC
	ISZ	LINPAG	/FULL PAGE?
	JMP I	CRLF	/NO
	CLA CMA
	DCA	LINPAG
/
/	NEW PAGE, WITH HEADING AND PAGE NO
/
	TAD	PASSNO	/IF NOT LISTING PASS
	SMA SZA CLA
	TAD	LISTSW	/OR IF NOT LISTING,
	SNA CLA
	JMP I	CRLF	/DO NOT EJECT
	TAD	RFORMF
	SZA		/DON'T F.F. FIRST TIME
	JMS I	PC	/TOP OF PAGE
	TAD	(214
	DCA	RFORMF
	JMS I	(PRTXT	/PRINT HEADING
	TITBUF-1
	-TITLEN
	TAD	LPAGE1	/FORM FEED COUNT
	JMS I	(DECOUT
	TAD	LPAGE2
	SNA CLA
	JMP	.+5	/NO SUB PAGE IF 0
	TAD	(255
	JMS I	PC
	TAD	LPAGE2
	JMS I	(DECOUT
	ISZ	LPAGE2
	TAD	(215	/FOR BH
	JMS I	PC
	TAD	(212
	JMS I	PC
	TAD	(-71	/RESET LINE COUNTER
	DCA	LINPAG
	JMP	CRLF+1	/GIVE ANOTHER CRLF
RFORMF,	0
/
/	PRINT TEXT
/
PRTXT,	0
	TAD I	PRTXT
	DCA	X13
	ISZ	PRTXT
	TAD I	PRTXT
	DCA	PRTTMP
	ISZ	PRTXT
	TAD I	X13
	JMS	PRINT2
	ISZ	PRTTMP
	JMP	.-3
	JMP I	PRTXT
PRTTMP=	PRNTLN
/
PRINT2,	0
	DCA	P2
	TAD	P2
	JMS I	[R6R
	JMS	P1
	TAD	P2
	JMS	P1
	JMP I	PRINT2
/
P1,	0
	AND	[77
	SNA
	JMP	.+4	/PRINT ZERO AS BLANK
	TAD	(-40	/TEST ABOVE OR BELOW 300
	SPA
	TAD	[100	/ABOVE, MAKE 301 TO 337
	TAD	[240	/IF BELOW, MAKE 240 TO 277
	JMS I	PC	/PRINT IT, WHATEVER IT IS
	JMP I	P1
/
TTYOUT,	0
	TLS
	TSF
	JMP	.-1
TTYCLA,	JMS I	(CKCTC	/CHECK FOR ^C - AC CONTAINS DIFFERENCE
	TAD	(-14	/CTRL/O
	SZA CLA
	JMP I	TTYOUT
	TAD	.+2
	DCA	TTYOUT+1
	JMP I	TTYOUT
/
P2,	0
/
	IFZERO	RALF	<
TXLNK,	TEXT	" LINKS"
TXLLN=	.-TXLNK	>
	IFNZRO	RALF	<
TXABR,	TEXT	" ABS REFS"
TXALN=	.-TXABR	>
	PAGE
/
/	GET AND EVALUATE AN EXPRESSION
/
EXPR,	0		/GET EXPRESSION
	DCA	EXPVAL	/ZERO EXPR VALUE
	DCA	EXPVAL+1
	DCA	EXPVAL+2
	CLA IAC
	DCA	EXPDEF	/AND TYPE
	CLA IAC		/SET EXPR SWITCH TO NO EXPR
	DCA	EXPSW
	DCA	FPP2WD	/SET FORCE SWITCH OFF
	CLA IAC		/SET LASTOP TO +
	DCA	LASTOP
	IFZERO	RALF	<
	JMS I	(CHKLIT /GO CHECK FOR LITERAL>
	JMS I	(GETSGN /IGNORE +, BUMP LASTOP IF -
SYMBOL, JMS I	[GETNAM /NOW PICK UP NAME
	JMP	NOSYM	/NONE, TRY OTHER
	JMS I	[LOOKUP /LOOK IT UP
	JMP	UNDEF	/A NEW ONE
	IFZERO RALF	<
	JMP	ADR	/YES >
	IFNZRO	RALF	<
	CLL RAR
	SNA
	JMP	ADR
SCTN,	TAD I	LTEMP	/GET TYPE
	AND	(40	/FORCE BIT
	SZA CLA
	ISZ	FPP2WD	/SET FORCE EXPR SW
	TAD I	X10	/GET ESD FROM SYMBOL
	AND	[7770	/ESD ONLY
	DCA	WORD1	/INTERNALLY, SYMBOL VAL IS ZERO
	JMP	CLR2	/SO CLEAR WORD 2>
NOTDOT, TAD     (256-242        /IS IT DBL QUOTE?
        SZA CLA
        JMP     ENDEXP
        ISZ     NCHARS  /IS THERE ANOTHER CHAR?
        JMP     ISQUOT  /YES, USE IT
ENDEXP, JMS I   [BACK1  /PUT IT BACK
        TAD     EXPSW   /WAS THERE ANY EXPRESSION AT ALL?
        SZA CLA
        JMP     BAD     /NO, DON'T SKIP
        IFZERO  RALF    <
        TAD     LITRL   /WAS IT A LITERAL REF?
        SZA CLA
        JMS I   (CRLIT  /YES, STICK IT IN THE POOL>
        TAD     LASTOP  /TRAILING OPERATOR?
        SNA
        JMP     OKEXP   /NO, ALL IS FINE
        CLL RAR 	/IF PLUS OPERATOR
        TAD     XINCR   /AND THATS LEGAL
        SNA CLA
OKEXP,  ISZ     EXPR    /GOOD EXPR, BUMP RETURN
BAD,	JMS	CKCTC
	CLA
	JMP I	EXPR	/AND RETURN
/
NOSYM,  JMS I   (NUMBER /LOOK FOR A NUMBER
        JMP     ADREXP  /USE NUMBER
        JMS I   [GETCHR /NOT A NUMBER, GET A CHAR
        JMP     ENDEXP+1 /NONE LEFT, END
        TAD     (-256   /IS IT "." ?
        SZA
        JMP     NOTDOT  /NO, TRY FOR QUOTE
        TAD     LOCTR1  /THIS WAS LOC SYMBOL
        DCA     WORD1   /PUT VALUE INTO WORD1,2
        TAD     LOCTR2
        JMP     CLR2	  /AND USE VALUE
ISQUOT,	DCA WORD1
	TAD I	CHRPTR
	JMP	CLR2
CKCTC,	0
    CLA
	KSF		/IF NOTHING AT THE KEYBOARD,
        JMP I   CKCTC    /RETURN
	TAD	[200
	KRS		/ELSE, LOOK AT IT
	TAD	(-203	/IS IT CTRL/C?
	SNA
	JMP I	[7600	/GO TO MOMMA
	JMP I	CKCTC
ADR,    TAD I   LTEMP   /CHECK FORCE BIT FOR THIS SYMBOL
        AND     (40
        SZA CLA
        ISZ     FPP2WD  /AND SET SWITCH IF BIT ON
        TAD I   X10     /GET FIRST WORD OF VALUE
ONE,    DCA     WORD1   /SINGLE WORD SYMBOL, HIGH=0
        TAD I   X10     /GET REST OF SYMBOL
CLR2,   DCA     WORD2
        CDF     FLD0    /FIX FIELD
ADREXP, DCA     EXPSW   /KILL FIRST TIME SWITCH
        TAD     LASTOP  /PICK UP LAST OPERATOR
        TAD     ADROP   /MAKE A JMP I
        DCA     .+1
        0               /DO IT
ADROP,	JMP I	.
	ADRADD
	ADRSUB
	ADRMUL	
	ADRDIV
	ADRAND
	ADROR
	ADROR
UNDEF,	TAD	FPPSWT	/IS THIS AN FPP ADDR ?
	SNA CLA
	JMP	.+5	/NO, SKIP AROUND
	TAD I	LTEMP	/TURN ON FORCE BIT
	AND	(7737	/FOR THIS SYMBOL
	TAD	(40
	DCA I	LTEMP
	DCA	EXPDEF	/SET TYPE TO UNDEFINED
	CDF	FLD0	/FIX FIELD
	DCA	EXPSW	/KILL FIRST TIME SWITCH
	JMS I	[ERMSG
	2523		/*US*
OPR8R,	TAD	(OPR8RS-1 /SET POINTER
	DCA	X11	/TO OPERATOR TABLE
	DCA	LASTOP	/ZERO LASTOP
	JMS I	[GETCHR /GET CHAR
	JMP	ENDEXP+1 /NONE, DONE
	DCA	EXTMP	/SAVE IT
FINDOP, ISZ	LASTOP
	TAD I	X11	/GET NEXT LIST ENTRY
	SNA
	JMP	NOOPR	/ZERO IS END OF LIST
	TAD	EXTMP	/COMPARE
	SZA CLA
	JMP	FINDOP	/LOOP
	JMP	SYMBOL	/LOOK FOR OPERAND
NOOPR,	DCA	LASTOP	/NO MATCH FOUND
	JMP	ENDEXP	/PUT IT BACK
	PAGE
ADRADD,	IFNZRO	RALF	<
	TAD	WORD1
	AND	[7770	/IF THIS SYMBOL IS RELOCATABLE,
	SZA CLA		/CHECK FOR EXPR VALIDITY
	JMS I	(RELERR	>
	TAD	EXPVAL+2 /ADD FOR 15 BIT ADDRESS
	CLL		/ZERO LINK
	TAD	WORD2	/ADD LOW WORDS
	DCA	EXPVAL+2 /SAVE RESULT
	RAL		/PUT CARRY INTO BIT 11
	TAD	WORD1	/ORDER WORDS
	JMP	ADRASX	/LOOK FOR OPERATOR
ADRSUB,	IFNZRO	RALF	<
	TAD	WORD1	/IF SYMBOL IS RELOCATABLE
	AND	[7770	/WE MUST COMPARE SECTIONS
	CIA		/IF EQUAL, EXPR BECOMES ABSOLUTE
	SNA		/ELSE, EXPR IS ILLEGAL
	JMP	.+5	/OK, USE EXPVAL ESD
	JMS I	(RELERR /COMPARE: AC DELIBERATELY NON-ZERO
	TAD	EXPVAL+1
	AND	[7	/IF WORD RELOCATABLE, EXP IS ABS
	DCA	EXPVAL+1	>
	TAD	WORD2	/SUBTR LOW 12 BITS
	CLL CML CIA
	TAD	EXPVAL+2
	DCA	EXPVAL+2 /SAVE LOW HALF
	RAL
	TAD	WORD1	/SUBTRACT HIGH HALF
	CIA
	AND	[7	/DO NOT SUBTR ESD'S
ADRASX,	TAD	EXPVAL+1
	AND	(7767	/PREVENT CARRY INTO BIT 8
ADRASY,	DCA	EXPVAL+1 /SAVE HIGH HALF
	JMP I	(OPR8R	/GET OPERATOR
/INDXX HERE FOR FLAP
	IFZERO	RALF	<
/	SET BASE AND INDEX LOCS
INDXX,	CLA STL RTL	/INDXR MUST JUST FOLLOW BASER
BASEX,	TAD	(BASER-1	/POINT TO VALUE TO BE SET
	DCA	X12	/HOPEFULLY UNUSED XR
	JMS I	(ADRGET	/COLLECT EXPRESSION
	TAD 	EXPVAL+1
	DCA I	X12	/HIGH ORDER AND ESD
	TAD	EXPVAL+2
	DCA I	X12	/LOW ORDER
	JMP I	[NEXTST	>
ADRAND,	TAD	WORD1	/AND
	AND	EXPVAL+1 /HIGH
	AND	[7	/3 BITS
	DCA	EXPVAL+1 /HALF
	TAD	WORD2	/THEN
	AND	EXPVAL+2 /LOW
	JMP	ADRAOX
ADROR,	TAD	WORD1	/OR IS PERFORMED BY
	CMA		/SETTING THE BITS
	AND	EXPVAL+1 /THAT ARE ON IN B AND NOT ON IN A
	TAD	WORD1	/AND THEN SETTING THE BITS
	AND	[7
	DCA	EXPVAL+1 /THAT ARE ON IN A
	TAD	WORD2
	CMA
	AND	EXPVAL+2
	TAD	WORD2
ADRAOX,	DCA	EXPVAL+2
	IFNZRO	RALF	<
	JMS I	(NOREL	/**>
	JMP I	(OPR8R	/GET NEXT OPERATOR
/
ADRMUL,	TAD	WORD2	/**RL CODE
	CIA
	DCA	EXPVAL+1	/MULT BY 
	TAD	EXPVAL+2	/REPEATED ADDITIONS
	ISZ	EXPVAL+1
	JMP	.-2
	JMP	ADRAOX
ADRDIV,	DCA	WORD1
	DCA	EXPVAL+1
	TAD	WORD2
	SNA	CLA
	JMP	DIVERR
	TAD	EXPVAL+2
	CIA	CLL
	TAD	WORD2
	SZL
	JMP	.+3	/DIVIDE BY
	ISZ	WORD1	/COUNTING SUBTRACTIONS
	JMP	.-4
	CLA
	TAD	WORD1
	JMP	ADRAOX
DIVERR, JMS I   [ERMSG
        0626            /*DV*
        JMP I   (OPR8R  /CONTINUE
PDPOPR,	TAD	CHRPTR
	DCA	CPTMP
	TAD	NCHARS
	DCA	NCTMP
	JMS I	[GETNAM	/LOOK FOR ANOTHER MICRO-INST
	JMP	TRYEXP	/NONE
	TAD	(33	/USE INTERNAL TABLE
	JMS I	[FIND	/IS IT THERE ?
	JMP	TRYEXP	/NO
	TAD	(-PDPOP	/IS IT AN OPERATE ?
	SZA CLA
	JMP	TRYEXP	/NO
	TAD I	X10	/GET VALUE
	CDF	FLD0
	DCA	EXPVAL+2
PDPOR,	TAD	EXPVAL+2
	CMA		/OR THEM TOGETHER
	AND	OPCODE
	TAD	EXPVAL+2
	DCA	OPCODE
	JMS I	[GETCHR	/MORE CHARS ?
	JMP I	(FPPS3	/NO-DONE
	TAD	[-240	/BLANK ?
	SNA CLA
	JMP	PDPOPR	/YES-PROCESS NEXT
	JMP I	(BADEXP
TRYEXP,	CDF	FLD0
	TAD	CPTMP
	DCA	CHRPTR
	TAD	NCTMP
	DCA	NCHARS
	ISZ	NCTMP
	SKP
	JMP I	(FPPS3
	JMS I	[EXPR
	JMP I	(BADEXP
	JMP	PDPOR
TXSYM,	TEXT " SYMBOLS,"
	TXSLN=.-TXSYM
	PAGE
        IFZERO  RALF    <
/
/       LITERAL THINGS
/
CHKLIT, 0               /CHECK FOR LITERAL
        DCA     PAGENO  /ZERO PAGE NUMBER
        DCA     LITRL
        JMS I   [GETCHR /GET CHARACTER
        JMP I   CHKLIT  /NO LITERAL
        TAD     (-250   /CHECK FOR (
        SNA
        ISZ     PAGENO  /CURRENT PAGE LITERAL
        SZA             /SKIP IF ALREADY ZERO
        TAD     (-63    /CHECK FOR [
        SNA
        ISZ     LITRL   /SET SWITCH
        SZA CLA
        JMS I   [BACK1  /PUT BACK NON ([
        JMP I   CHKLIT
/
/       CREATE A LINK FOR OFF-PAGE REFERENCE
/
MAKLNK, TAD     (THSPAG /PROPER RETURN ADDR
        DCA     CRLIT
        TAD     OPCODE  /SET INDIRECT BIT
        TAD     (400
        DCA     OPCODE
        CLA IAC
        DCA     PAGENO  /SET INDICATOR
        ISZ     LINKS   /COUNT ANOTHER LINK GENERATED
        ISZ     LINKSW  /SET SWITCH FOR APOSTROPHE OUTPUT
        JMP     NOTP0
CRLIT,  0               /CREATE LITERAL
                        /VALUE:EXPVAL, IN PAGE:PAGENO
        TAD     PAGENO  /CHECK FOR PAGE 0
        SNA CLA
        JMP     ISP0    /PAGE 0 LITERAL
NOTP0,  TAD     (CPLBUF /SET PTR TO LITERAL BUFFER
        DCA     LITBAS
        TAD     LOCTR2  /CHECK FOR LIT BUFFER FULL
        AND     [100
        SNA CLA
        JMP     DOLIT-1 /USE 77 AS LIMIT
        TAD     LOCTR2
        AND     [177
        JMP     DOLIT   /USE CURRENT ADDR AS LIMIT
ISP0,   TAD     (P0LBUF /USE PAGE 0 LIT BUFFER
        DCA     LITBAS
        TAD     [77     /ASSUME FIRST 64 WORDS USED
DOLIT,  DCA     NWUSED
        TAD     PAGENO  /GET POINTER TO
        TAD     [P0LIT  /LITERAL BOUNDARY
        DCA     XPAGE
        TAD I   XPAGE   /DISPLACEMENT OF LIT BUFR - 1
        DCA     LITPTR  /INTO LITPTR
NOTIT,  TAD     LITPTR  /POINTER+SIZE
	TAD	(-177    /SHOULD BE LESS THAN 177
        SMA CLA
        JMP     NEWLIT  /ENTER NEW LITERAL
        TAD     LITPTR  /NOW GET POINTER
        TAD     LITBAS  /TO TABLE
        DCA     X11     /FOR COMPARISON
        ISZ     LITPTR  /INCREMENT POINTER
        TAD I   X11     /GET WORD OF LITERAL
        CIA
        TAD     EXPVAL+2 /COMPARE PROTOTYPE
        SZA CLA
        JMP     NOTIT   /NOT IT, SLIDE POINTER AND RETRY
LITADR, TAD     PAGENO  /PAGE 0 ?
        SZA CLA
        TAD     LOCTR2  /NO, CURRENT PAGE, GET ADDRESS
        AND     [7600
        TAD     LITPTR  /PLUS PAGE DISPLACEMENT
        DCA     EXPVAL+2        /INTO VALUE
        TAD     LOCTR1
RETLIT, DCA     EXPVAL+1
        JMP I   CRLIT
NEWLIT,	CLA CMA
	TAD I	XPAGE	/MOVE LITERAL BOUNDARY DOWN
	DCA	X10	/ADDRESS OF NEW LITERAL
	TAD	NWUSED	/CHECK FOR PAGE OVERFULL
	CIA
	TAD	X10
	SMA CLA
	JMP	.+5	/NOT FULL
	JMS I	[ERMSG	/*PO*
	2017
	DCA	EXPVAL+2	/ZERO ADDRESS
	JMP	RETLIT
	TAD	X10
	DCA I	XPAGE
	TAD I	XPAGE	/SET UP POINTER FOR MOVE
	TAD	LITBAS
	DCA	X10
	TAD	EXPVAL+2 /MOVE LITERAL IN
	DCA I	X10
	TAD I	XPAGE	/SET UP LITERAL ADDRESS
	IAC
	DCA	LITPTR
	JMP	LITADR	/RETURN LITERAL ADDRESS
LITBAS,	0
NWUSED,	0
LITPTR,	0
PAGENO,	0
XPAGE,	0
	PAGE	/>
/
/	FIND SYMBOL TABLE ENTRY
/	FOR THE SYMBOL IN BUCKET AND NAME 1, 2, 3
/	SKIP IF FOUND WITH TYPE IN AC
/
FIND,	0		/SYMBOL TABLE LOOKUP
	TAD	BUCKET	/GET BUCKET ADDRESS
	CDF	FLD1	/GO TO FIELD 1
LOOK,	DCA	OLDN3	/THIS IS PTR OF PREV ENTRY
	TAD I	OLDN3	/THIS IS ADR OF NEXT ENTRY
	SNA		/IF ZERO, THEN
	JMP I	FIND	/IT AIN'T HERE
	DCA	X10	/SAVE NEXT NAME PTR
	TAD	NAME1	/COMPARE NAMES
	CIA CLL
	TAD I	X10	/WORD 1
	SZA CLA
	JMP	NOTSAM
	TAD	NAME2
	CIA CLL
	TAD I	X10	/WORD2
	SZA CLA
	JMP	NOTSAM
	TAD	NAME3
	CIA CLL
	TAD I	X10	/COMPARE LAST CHAR
	AND	[7700	/HIGH HALF ONLY
	SZA CLA
	JMP	NOTSAM
	ISZ	FIND	/IF FOUND BUMP RETURN
	TAD	X10
	DCA	LTEMP	/ADDR OF TYPE WORD
	TAD I	LTEMP	/GET TYPE INTO AC
	AND	[37	/WITHOUT FORCE BIT
	JMP I	FIND	/RETURN
NOTSAM,	SZL CLA		/IS NAME 1,2,3 .LT. ENTRY
	JMP I	FIND	/YES, IT ISN'T HERE
	TAD I	OLDN3	/GET ADDR OF LINK INTO AC
	JMP	LOOK	/LOOP
/
/	FIND SYMBOL, OR IF NOT THERE, CREATE ENTRY FOR IT
/
LOOKUP, 0
	JMS	FIND
	JMP	.+4
	SZA
	ISZ	LOOKUP	/SKIP RETURN IF DEFINED
	JMP I	LOOKUP	/RETURN TYPE CODE
	TAD I	OLDN3	/GET FORWARD LINK TO
	DCA I	NEXT	/NEXT ENTRY INTO NEW ENTRY
	TAD	NEXT	/PUT FORWARD LINK TO NEW
	DCA I	OLDN3	/ENTRY INTO PREVIOUS ENTRY
	TAD	NAME1	/PUT IN NAME
	DCA I	NEXT
	TAD	NAME2
	DCA I	NEXT
	TAD	NAME3
	DCA I	NEXT
	TAD	NEXT	/X10=NEXT
	DCA	X10
	TAD	NEXT	/LTEMP=NEXT
	DCA	LTEMP
	DCA I	NEXT	/INITIAL VALUE IS ZERO
	DCA I	NEXT
	TAD	NEXT	/CHECK FOR TABLE FULL
	CLL
	TAD	[200	/GONNA OVERFLO PS8?
	SNL CLA
	JMP I	LOOKUP	/NO PROBLEMS, RETURN (NO SKIP)
	JMS I	[ERMSG1
	2324		/*ST*
/
/	COLLECT AN INTEGER IN THE CURRENT RADIX
/
NUMBER,	0		/GET INTEGER NUMBER (NO SIGN)
	DCA	NSWTCH	/CLEAR SWITCH
	DCA	NOFLO	/CLEAR OVRFLO SW
	DCA	WORD1	/CLEAR 24 BIT NUMBER
	DCA	WORD2
NUMLUP,	JMS I	(DIGIT
	JMP	NODGT	/TOO BAD
	DCA	NUM	/YES, SAVE IT
	TAD	WORD1	/SAVE CURRENT VALUE
	DCA	NUM1	/OF NUMBER
	TAD	WORD2
	DCA	NUM2
	JMS	SHIFT	/SHIFT WORD1,2, LEFT 1 (MULT BY 2)
	JMS	SHIFT	/DO IT AGAIN (MULT BY 4)
	TAD	RADIX	/LOOK AT RADIX (1=DECIMAL)
	SNA CLA
	JMP	OCTNUM	/ITS OCTAL
	CLL		/DECIMAL, ADD IN NUMBER
	TAD	NUM2
	TAD	WORD2	/THUS MULTIPLYING BY 5
	DCA	WORD2
	RAL
	TAD	NUM1
	TAD	WORD1
	DCA	WORD1
	JMP	ADDDGT
OCTNUM,	TAD	NUM
	AND	[7770	/CHECK FOR 8 OR 9
	SZA CLA
	ISZ	NOFLO	/SET ERROR FLAG
ADDDGT,	JMS	SHIFT	/SHIFT LEFT 1 AGAIN, THUS
	TAD	WORD2	/MULTIPLYING BY 8 OR 10
	CLL		/THEN ADD IN NEW DIGIT
	TAD	NUM
	DCA	WORD2
	RAL
	TAD	WORD1
	DCA	WORD1
	SZL		/BEWARE OF OVERFLO
	ISZ	NOFLO
	JMP	NUMLUP	/LOOP
NODGT,	TAD	NSWTCH	/WAS THERE A NUMBER
	SNA CLA
	ISZ	NUMBER	/NO, SKIP
	TAD	WORD1
	AND	[7770	/CHECK FOR MORE THAN 15 BITS
	SNA
	TAD	NOFLO	/OR GROSS OVERFLOW
	SNA CLA
	JMP I	NUMBER	/ALL GREEN
	JMS I	[ERMSG
	1605		/*NE*
	JMP I	NUMBER	/RETURN
NOFLO=	LOOKUP		/ZERO IF NO ERRORS
NUM=	FIND
NUM1=	EXTMP
NUM2=	EXTMP2
NSWTCH,			/ZERO IF NO DIGITS
SHIFT,	0		/SHIFT DOUBLE WORD LEFT 1
	TAD	WORD2
	CLL RAL
	DCA	WORD2
	TAD	WORD1
	RAL
	DCA	WORD1
	SZL		/IF BIT SHIFTED FROM HI WORD,
	ISZ	NOFLO	/SET ERROR FLAG
	JMP I	SHIFT
	PAGE
/
/	BACK UP GETCHR POINTERS,
/	WE DON'T WANT THIS ONE
/
BACK1,	0
	CLA CMA		/BACKUP COUNT
	TAD	NCHARS
	DCA	NCHARS
	CLA CMA		/AND POINTER
	TAD	CHRPTR
	DCA	CHRPTR
	JMP I	BACK1
/
/	GET NEXT CHAR FROM LINE BUFFER
/	FOR ASSEMBLY PURPOSES ONLY
/	SKIP UNLESS END OF LINE (CR, ;, OR /)
/
GETCHR,	0
	JMS	GETAC
GETSKP,	ISZ	GETCHR	/SKIP RETURN
	JMP I	GETCHR
BLANK,	JMS	GETAC	/COME HERE IF BALNK OR TAB
	TAD	(-257	/END OF LINE ON SLASH AFTER BLANK
	SNA CLA
	JMP	GETCND
	JMS	BACK1	/PUT IT BACK
	TAD	[240	/AND RETURN A SINGLE BLANK
	JMP	GETSKP	/SKIP OUT
SEMICL,	ISZ	SCSWT
	JMS	BACK1	/PUT BACK SEMI COLON
	JMP I	GETCHR
GETAC,	0
	ISZ	NCHARS	/END OF LINE?
	JMP	.+4	/NO, GET IT
GETCND,	CLA CMA		/YES, RESET IN CASE OF 
	DCA	NCHARS	/ANOTHER CALL
	JMP I	GETCHR	/RETURN END OF LINE
	TAD I	CHRPTR	/PICK UP NEXT
	TAD	[-240	/CHECK FOR BLANK
	SZA
	TAD	(240-211 /OR TAB
	SNA
	JMP	BLANK	/THEY GET SPECIAL HANDLING
	TAD	(211-273 /LOOKOUT FOR SEMICOLON
	SNA
	JMP	SEMICL	/ALSO SPECIAL
	TAD	(273-276 /IGNORE CLOSE ANGLE BRACKET
	SNA
	JMP	GETAC+1	/GET ANOTHER
	TAD	(276	/ELSE, RESTORE CHAR
	JMP I	GETAC	/AND PASS IT BACK
/
/	COLLECT A SYMBOL IN BUCKET, NAME 1,2, & 3
/	NO SKIP ON RETURN IF NO SYMBOL
/
GETNAM,	0
	DCA	NAME1	/CLEAR SYMBOL SPACE
	DCA	NAME2
	DCA	NAME3
	JMS	LETTER	/GET A LETTER
	JMP	ISSYM
	JMS	GETCHR	/CHECK FOR #
	JMP I	GETNAM	/NOPE
	TAD	(-"#
	SNA CLA
	JMP	ISSYM
	JMS	BACK1
	JMP I	GETNAM
ISSYM,	DCA	BUCKET
	ISZ	GETNAM	/ONE LETTER DOTH A SYMBOL MAKE
	JMS	GNC	/FRIENDLY LOCAL SUBR
	JMS	R6L
	DCA	NAME1
	JMS	GNC
	TAD	NAME1
	DCA	NAME1
	JMS	GNC
	JMS	R6L
	DCA	NAME2
	JMS	GNC
	TAD	NAME2
	DCA	NAME2
	JMS	GNC
	JMS	R6L
	DCA	NAME3
	JMS	GNC	/AFTER 6, WE IGNORE
	SKP CLA
GNC,	0
	JMS	LETTER
	JMP I	GNC	/RETTURN LETTER
	JMS	DIGIT
	JMP I	GETNAM	/EMPTY HANDED, RETURN TO CALLER
	TAD	(60
	JMP I	GNC
/
/	IF NEXT CHAR IS A LETTER, RETURN 6 BITS
/	IF NOT, REPLACE CHAR AND SKIP.
/
LETTER,	0
	JMS	GETCHR
	JMP	NLETR	/NO LETTER, SKIP
	TAD	(-333
	CLL CML
	TAD	(33
	SZA SNL		/DON'T ALLOW 300
	JMP I	LETTER
	JMS	BACK1
NLETR,	ISZ	LETTER
	JMP I	LETTER
/
/	IF NEXT CHAR IS A DIGIT (0-9) RETURN VALUE AND SKIP
/
DIGIT,	0
	JMS	GETCHR
	JMP I	DIGIT
	TAD	(-272
	CLL
	TAD	(12
	SNL
	JMP	NDIGT
	ISZ	DIGIT
	JMP I	DIGIT
NDIGT,	JMS	BACK1
	JMP I	DIGIT
/
R6L,	0
	CLL RTL
	RTL
	RTL
	JMP I	R6L
/
R6R,	0
	RTR
	RTR
	RTR
	AND	[77
	JMP I	R6R
	PAGE
/
/	BUILD AN INSTRUCTION
/
FIXOPC,	0		/COMBINE OPCODE PARTS
	TAD	XFLAG	/CHECK INDEX SWITCH
	SNA CLA
	JMP	ZRONDX	/IF ZERO, NO INDEX REG
	CLA CMA
	TAD	LASTOP	/IF INDEX, CHECK FOR INCR
	SNA CLA
	TAD	[100	/YES, PUT + BIT ON
	TAD	OPCODE	/COMBINE WITH OPCODE
	DCA	OPCODE
	TAD	EXPVAL+2 /GET INDEX REG. EXPR
	AND	[7	/ONLY 3 BITS
	CLL RTL		/SHIFT INTO POSITION
	RAL
ZRONDX,	TAD	OPCODE	/ADD OPCODE
	TAD	(400	/TURN ON TYPE BIT
	DCA	OPCODE	/SAVE OPCODE
	JMP I	FIXOPC	/RETURN
/
OPR8RS,
	-253		/PLUS
	-255		/MINUS
	-252		/STAR (MULTIPLY) **
	-257		/SLASH (DIVIDE)
	-246		/AMPERSAND (AND)
	-240		/SPACE (OR)
	-241		/EXCLAMATION (OR)
	0		/END OF LIST
/
/	FATAL ERRORS
/
ERMSG1, 0		/PASS 1 (FATAL) MESSAGES
	CDF
	TAD I	ERMSG1	/GET CODE
	DCA	.+3
	DCA	PASSNO
	JMS	ERMSG	/DO THE MSG THING
	0
	IFZERO	RALF	<
RETSYS, 	>
	TSF		/FINISH TYPING
	JMP	.-1
	JMP I	[7600	/EXIT TO PS8
/
/	GENERAL GARBAGE TYPE ERRORS
/
ERMSG,	0
	CDF	FLD0	/FIX FIELD
	CLA		/NO MESSAGE ON PASS 1
	TAD	PASSNO
	SMA SZA		/IF PASS 3, OUTPUT LEADING CRLF
	JMS I	[CRLF
	SPA CLA
	JMP	MSGDUN
	TAD	(5555	/MINUSES
	JMS I	[PRINT2
	TAD I	ERMSG	/2-CHAR CODE
	JMS I	[PRINT2 /PRINT THE MESSAGE
	TAD	(5555
	JMS I	[PRINT2
	TAD	PASSNO
	SZA CLA
	JMP	.+4
	JMS I	[PRINT2
PLINE,	JMS I	(PRNTLN
	JMS I	[CRLF
	ISZ	ERRORS	/BUMP COUNT
MSGDUN, ISZ	ERMSG
	JMP I	ERMSG
/
/	OUTPUT DECIMAL
/	SUPPRESS LEADING ZEROS
/	PRINT "NO" INSTEAD OF "0"
/
DECOUT,	0
	SNA		/ZERO IS SPECIAL
	JMP	DECNO	/NO INSTEAD OF 0
	DCA	OTEMP
	DCA	OCNT
	JMS	DEC2	/GET THOUSANDS
	-1750
	JMS	DEC2	/HUNDREDS
	-144
	JMS	DEC2	/TENS
	-12
	TAD	OTEMP	/UNITS (NO ZERO SUPPRESS HERE)
	JMS	PDIG	/PRINT LAST DIGIT
	JMP I	DECOUT	/EASY, WHEN YOU KNOW HOW
/
DECNO,	TAD	(1617	/NO
	JMS I	[PRINT2
	JMP I	DECOUT
/
/	LAZY MAN'S DIVISION
/
DEC2,	0
	CDF	FLD0	/JUST TO MAKE SURE
DEC3,	CLA CLL
	TAD	OTEMP
	SNA
	JMP	DEC4
	TAD I	DEC2	/SUBTRACT DIVISOR
	SNL		/TOO MUCH?
	JMP	DEC4	/YES, STOP NOW
	DCA	OTEMP	/NO, SAVE NEW REMAIN
	ISZ	OCNT	/BUMP QUOTIENT
	JMP	DEC3	/DO IT AGAIN
DEC4,	CLA
	ISZ	DEC2	/SKIP RETURN
	TAD	OCNT	/CHECK FOR SIGNIFICANCE
	SNA
	JMP I	DEC2	/NONE
	JMS	PDIG
	CLA STL RAR	/FORCE SIGNIFICANCE
	DCA	OCNT
	JMP I	DEC2
/
TENTH,	-111
	1463;1463;1463
	1463;1463;1463
TEN,	1
PDIG,	0
	TAD	P260
	JMS I	PC
	JMP I	PDIG
P260,	260
	5
/
/	OCTAL CONVERSION, THE HARD WAY
/
OCTOUT,	0
	DCA	OTEMP
	STL RAR		/NO ZERO SUPPRESS
	DCA	OCNT
	JMS	DEC2
	-1000
	JMS	DEC2
	-100
	JMS	DEC2
	-10
	TAD	OTEMP
	JMS	PDIG
	JMP I	OCTOUT
	PAGE
/
/	OUTPUT ONE WORD
/
	IFNZRO	RALF	<
/
/	TEXT TYPE CODES:
TTABS=	0400
TTORG=	1000
TTREL=	1400
/
OUTREL, DCA	WRD	/HOLD FIRST WORD
	DCA	LINKSW	/CLEAR ABSOLUTE REF INDICATOR
	TAD	FPPADR	/GET ESD CODE
	RTR
	RTR		/RIGHT IN AC
	AND	[177	/STRIP TO ESD ONLY
	SNA		/CHECK FOR ABSOLUTE
	JMP	PUTABS
	DCA	FPPADR	/SAVE ESD
	TAD	PASSNO	/CHECK FOR PASS 2
	SZA CLA
	JMP	PRNTRL	/IF NOT, TREAT NORMALLY
	DCA	ABSOP
	CLA STL RTL
	JMS I	(FULCHK	/ENSURE 3 WORDS LEFT
	TAD	FPPADR	/GET ESD AGAIN
	TAD	(TTREL	/INSERT CONTROL CODE
	DCA I	OUTPTR
	TAD	WRD	/FIRST DATUM
	DCA I	OUTPTR
	TAD	FPPADR+1
	DCA I	OUTPTR
	JMS I	(FULCHK	/IS IT FULL?
	JMS	BMPLOC	/TWO WORDS OUT
	JMS	BMPLOC	/SO LOCCTR +2
	JMP I	[NEXTST
PUTABS,	ISZ	ABREFS	/COUNT IT
	ISZ	LINKSW	/SET FLAG
PRNTRL,	TAD	WRD	/GET FIRST WORD
	JMS	OUTWRD
	TAD	FPPADR+1
	JMS	OUTWRD
	JMP I	[NEXTST	>
/
OUTWRD, 0	       /OUTPUT ROUTINE
        DCA     WRD     /SAVE WORD
        IFZERO  RALF    <
        TAD     LOCTR2  /GET LOW 12 BITS OF LOCATION
        JMS I   [R6L
        AND     [37     /GET PAGE NUMBER (WITHIN FIELD)
        DCA     OTEMP   /SAVE PAGE NUMBER
        TAD     OTEMP
	SZA CLA		/POINTER TO LITERAL POINTER
        IAC
        TAD     [P0LIT
        DCA     OWTEMP
        TAD     LOCTR2  /GET CURRENT ADDRESS DISPLACEMENT
        AND     [177
	CIA		/COMPARE WITH LITERAL BOUNDARY
        TAD I   OWTEMP
        SMA CLA
        JMP     .+3     /NO PAGE OVER FLOW
        JMS I   [ERMSG
	2017		/*PO*>
	TAD	PASSNO	/CHECK PASS
	SZA
	JMP	PRNTST	/ITS NOT PASS 2
	IFZERO	RALF	<
        TAD     WRD     /NOW OUTPUT WORD
        JMS I   [R6R
        JMS     OOCHAR
        TAD     WRD
        AND     [77
        JMS     OOCHAR  >
        IFNZRO  RALF    <
        TAD     ABSOP   /CHECK FOR ALREADY IN ABS OUTPUT
        SZA CLA
        JMP     INABS   /NO PROBLEM
        CLA IAC
        JMS I   (FULCHK
        TAD     (TTABS  /SET ABS CONTROL CODE
        DCA I   OUTPTR
        TAD     OUTPTR  /SAVE POINTER FOR FUTRUE REF
        DCA     ABSOP
INABS,  ISZ I   ABSOP   /BUMP COUNT
        TAD     WRD
        DCA I   OUTPTR
        JMS I   (FULCHK /GOOD!>
PRNTST, SMA SZA CLA
	TAD	LISTSW	/IS LIST ON ?
	SNA CLA
	JMP	ENDOUT	/NO, DONT PRINT
	JMS I	[CRLF	/NEW LINE
	TAD	LOCTR1	/PRINT LOCATION COUNTER
	AND	[7
	JMS I	(PDIG
	TAD	LOCTR2	/NEXT FOUR DIGITS
	JMS I	[OCTOUT
	TAD	[240
	JMS I	PC
	TAD	WRD	/NOW WORD
	JMS I	[OCTOUT
	TAD	LINKSW	/LINK GENERATED ON THIS LINE?
	SZA CLA
	TAD	(4700	/IF SO, GIVE APOSTROPHE SPACE
	JMS I	[PRINT2
	DCA	LINKSW	/CLEAR SW
	JMS I	(PRNTLN /PRINT LINE IF NECESSARY
ENDOUT,	JMS	BMPLOC	/BUMP LOC CNTR
	JMP I	OUTWRD	/RETURN
/
WRD,
BMPLOC,	0
	ISZ	LOCTR2	/BUMP LOW ORDER
	JMP I	BMPLOC
	CLA IAC
	TAD	LOCTR1
	AND	(7767	/STOP CARRY INTO BIT 8
	DCA	LOCTR1
	JMP I	BMPLOC
	IFZERO	RALF	<
/
/	PUNCH CONTROL
/
NOPNCX,	CLA IAC
ENPNCX,	DCA	PNCHOF
	JMP I	[NEXTST
/
/	OUTPUT AN ORIGIN
/
PUTORG, 0
	TAD	PASSNO	/CHECK FOR PASS 2
	SZA CLA
	JMP I	PUTORG	/ELSE FORGET IT
	TAD	LOCTR2	/OUTPUT FIRST CHAR
	JMS I	[R6R
	TAD	[100
	JMS	OOCHAR	/OUTPUT CHAR
	TAD	LOCTR2	/NOW LOWER HALF OF ORIGIN
	AND	[77
	JMS	OOCHAR
	JMP I	PUTORG
OWTEMP,
CHAROO, 0
OOCHAR, 0		/OUTPUT CHAR AND COMPUTE CHKSUM
	DCA	CHAROO
	TAD	PNCHOF	/PUNCHING?
	SZA CLA
	JMP I	OOCHAR	/NOPE
	TAD	CHAROO
	TAD	CHKSUM
	DCA	CHKSUM
	TAD	CHAROO
	JMS I	[OCHAR
	JMP I	OOCHAR	>
/
/	BEGIN NEXT PASS
/	WITH APPROPRIATE THINGS RESET
/	TO DEFAULT VALUES
/
RESET,	JMS I	(IOPEN	/RE-SELECT FIRST INPUT FILE
	TAD	USR	/EITHER 200 OR 7700
	SPA CLA		/IS USR IN CORE?
	JMP	.+6	/NO
	CIF	10	/YES, DISMISS IT
	JMS I	USR
	11		/USROUT
	TAD	[7700
	DCA	USR	/ITS GONE
	IFNZRO	RALF	<
	CLA STL RTL	/COUNTING FROM 2,
	DCA	ESDNO	/RESET ESD COUNT
	JMS I	(CLRSCT	/ZERO ALL SECTION LENGTHS>
	DCA	ASMOF	/ZERO CONDITIONAL SWITCH
	DCA	SCSWT	/ZERO SEMICOLON SWITCH
	TAD	SYONLY	/IF NOT SYM MAP ONLY
	DCA	LISTSW	/FORCE LIST ENABLE
	CLA IAC
	DCA	LPAGE1
	DCA	LPAGE2
	CLA CMA
	DCA	LINPAG
	IFZERO	RALF	<
	TAD	[177
	DCA	P0LIT	/RESET LITERAL BUFFER POINTERS
	TAD	[177
	DCA	CPLIT
	TAD	[200	>
	DCA	LOCTR2	/LOCATION COUNTER
	IFNZRO	RALF	<
	TAD	(20	>
	DCA	LOCTR1
	CLL CML RAR	/4000
	DCA	BASER	/SET BASE BEYOND BELIEF
	DCA	INDXR
	DCA	INDXR+1
	DCA	RADIX	/RESET DEFAULT OCTAL
	DCA	ERRORS	/ZERO ERROR COUNT
	DCA	LINKS
	ISZ	PASSNO	/BUMP PASS NUMBER
	JMP I	(NEWLIN
	JMP I	(NEWLIN	/DO NEXT PASS
	PAGE
/
/	END OF A PASS
/
ENDX,	IFZERO	RALF	<
	DCA	PNCHOF	/RE-ENABLE PUNCH>
	IFNZRO	RALF	<
	JMS I	(BORG	/SET MAX LEN OF CURRENT SECT>
	TAD	PASSNO
	SMA CLA		/WHAT PASS WAS THIS?
	JMP	EOP2	/NOT THE FIRST
	IFNZRO	RALF	<
	TAD	(INBUF-400
	DCA I	(INBUFP	/MOVE INPUT BUFFER OVER DMPESD>
	TAD	BFILE
	SNA CLA
	JMP	START3	/NO BINARY, START PASS 3
	IFZERO	RALF	<
	TAD	[200	/START BIN OUT WITH L/T
	JMS I	[OCHAR
	JMP I	(RESET	>
	IFNZRO	RALF	<
	JMP I	(DMPESD	/OUTPUT EXT SYM TABLE>
/
EOP2,	IFZERO	RALF	<
	CLA IAC		/DUMP CURRENT PAGE LITERALS
	JMS I	(DMPLIT
	JMS I	(DMPLIT	/THEN DUMP PAGE 0 LITERALS>
	TAD	PASSNO
	SMA SZA CLA
	JMP	EOP3	/YES, PRINT SYMBOL TABLE
	IFZERO	RALF	<
	TAD	CHKSUM	/OUTPUT CHECKSUM
	JMS I	[R6R
	JMS I	[OCHAR
	TAD	CHKSUM
	AND	[77
	JMS I	[OCHAR	/LOWER HALF
	TAD	[200	/TRAILER CHAR
	JMS I	[OCHAR	>
	IFNZRO	RALF	<
	DCA I	OUTPTR	/SET OUTPUT END INDICATOR>
	JMS I	(OCLOSE	/CLOSE THE BINARY FILE
START3,	DCA	PASSNO	/SKIP PASS TWO
	JMS I	(OOPEN	/OPEN LISTING FILE
	IFZERO	RALF	<
	JMP	NOP3	/NO LISTING, GIVE INFO ON TTY>
	IFNZRO	RALF	<
	JMP I	(RETSYS	>
	TAD	[OCHAR	/CHANGE PRINT ROUTINE
	DCA	PC
	JMP I	(RESET	/NO,RESET EVERYTHING
/
/       END OF LAST PASS
/       GIVE SOME STATISTICS
/
EOP3,   CLA CMA
        DCA     LINPAG
	JMS I   [CRLF
NOP3,	JMS I	(7607	/READ IN OVERLAY
	0100
OVERLY,	OVBUFR
	40		/USE SYS SCRATCH BLK
	JMP I	(7605
	JMP I	OVERLY

CHCKMR,	0
	TAD	OPCODE	/BE SURE ALL REFS ARE
	AND	[200	/ARE ON SAME PG
	SZA CLA
	TAD	LOCTR2
	AND	[7600
	CIA
	TAD	EXPVAL+2
	AND	[7600
	SZA	CLA
ADRERR,	JMS I	[ERMSG
	0201		/**BA**
	TAD	EXPVAL+2
	AND	[177
	TAD	OPCODE
	JMS I	[OUTWRD
	JMP I	[NEXTST

IOERR,	TAD	INOP		/REMOVE JMS PRNTLN
	DCA	PLINE
	JMS I	[ERMSG1
	1117			/**IO**
INOP,	NOP

	PAGE
        IFZERO  RALF    <
/       ORG THINGS FOR ABSOLUTE ASSEMBLIES
/
TRYSTR, JMS I   [GETCHR
        JMP I   [NEXTST /WHAT CAN YOU DO?
        TAD     (-252   /IS IT AN ORG
        SZA CLA
        JMP I   (GETEXP /NO, SOME FUNNY EXPR, MAYBE
ORGX,   JMS I   (ADRGET
        TAD     LOCTR1  /CHECK FOR NEW FIELD
        CIA
        TAD     EXPVAL+1
        SNA CLA
        JMP     SAMFLD  /NOT A DIFFERENT FIELD
        CLA IAC
        JMS     DMPLIT  /DUMP CURRENT PAGE LITERALS
        JMS     DMPLIT  /DUMP PAGE 0 LITERALS
        TAD     EXPVAL+1
        AND     [7
        DCA     LOCTR1
        TAD     PNCHOF  /PUNCHING ENABLED?
        SNA
        TAD     PASSNO  /PASS 2?
        SZA CLA
        JMP     SAMPAG  /NO, DON'T OUTPUT CHANGE FIELD
        TAD     LOCTR1  /NEW FIELD BITS
        RTL CLL
        RAL
        TAD     (300    /TURN ON THE LEFT TWO BITS
        JMS I   [OCHAR  /PUT IT OUT (NOT IN CHECK SUM)
        JMP     SAMPAG  /DO THE SAME FOR CURRENT PAGE
SAMFLD, TAD     LOCTR2
        AND     [7600   /CHECK FOR SAME PAGE
        DCA     LTEMP
        TAD     EXPVAL+2
        AND     [7600
        CIA
        TAD     LTEMP
        SNA CLA
        JMP     SAMPAG  /PAGE IS THE SAME
        CLA IAC
        JMS     DMPLIT  /DUMP CURRENT PAGE LITERALS
SAMPAG, TAD     EXPVAL+2
        DCA     LOCTR2
        JMS I   (PUTORG
        JMP I   [NEXTST /DONE
PAGEX,  TAD     LOCTR2  /ADVANCE TO NEXT PAGE
        CLL
        TAD     [177
        AND     [7600
        DCA     EXPVAL+2
        RAL
        TAD     LOCTR1
        DCA     EXPVAL+1
        JMP     ORGX+1  /DO ORG THINGS
DMPLIT, 0
	DCA	PAGEN	/SAVE PAGE INDICATOR
	TAD	OUTSWT	/SAVE OUTPUT SWITCH
	DCA	SWTOUT
	ISZ	OUTSWT	/DONT PRINT LINE WITH LITERALS
	TAD	PAGEN
	TAD	[P0LIT	/GET BOUNDARY POINTER
	DCA	LTEMP
	TAD	PAGEN	/WHICH LITERAL BUFFER ?
	SNA CLA
	TAD	(P0LBUF-CPLBUF	/PAGE 0 BUFFER
	TAD	(CPLBUF /CURRENT PAGE BUFFER
	TAD I	LTEMP	/PLUS	PAGE ADDRESS
	DCA	X10	/GIVES START OF LITERALS -1
	TAD	PAGEN
	SZA CLA
	TAD	LOCTR2	/UPPER FIVE BITS OF ADDRESS
	AND	[7600
	TAD I	LTEMP	/PLUS LOWER SEVEN
	IAC		/PLUS ONE
	DCA	LOCTR2	/GIVES LOCATION COUNTER
	TAD	LOCTR2
	AND	[177	/ANYTHING TO DUMP?
	SNA CLA
	JMP	DMPFIN	/NO
	TAD	PASSNO
	SMA SZA CLA
	JMS I	[CRLF	/ONLY IF PASS 3
	JMS I	(PUTORG
	TAD	[177	/STORE SPURIOUS LITERAL BOUNDARY
	DCA I	LTEMP	/TO PREVENT FALLACIOUS *PO* MESSAGES
LITLUP, TAD I	X10	/NO, GET NEXT LITERAL
	JMS I	[OUTWRD /OUTPUT WORD AND BUMP LC
	TAD	X10	/DONE?
	IAC
	AND	[77
	SZA CLA
	JMP	LITLUP	/LOOP
DMPFIN, TAD	SWTOUT	/RESTORE OUTPUT SWITCH
	DCA	OUTSWT
	JMP I	DMPLIT	/ALL DONE
SWTOUT, 0 >
EXPON,	TAD	LASTOP
	DCA	TMP
	DCA	LASTOP
	JMS I	(GETSGN		/GET SIGN OF EXPONENT
	TAD	RADIX
	DCA	OTEMP
	ISZ	RADIX		/SET RADIX TO DECIMAL
	JMS I	(NUMBER		/GET EXPONENT
	NOP
	TAD	OTEMP
	DCA	RADIX		/RESTORE RADIX
	TAD	TMP
	CLL RAR
	TAD	LASTOP
	RAR		/LASTOP TO LINK,
	DCA	LASTOP	/TMP TO SIGN OF LASTOP
	TAD	WORD2
	SZL
	CIA			/PUT SIGN ON EXP
	JMP I	(OVER
TMP,	0
	IFZERO RALF	<	PAGE /	>
	IFNZRO	RALF	<
/
/	IF ALL CONDITIONS ARE RIGHT, CALL THE LOADER
/
RETSYS,	JMS I	(DELFIL	/THIS LOCATION USED BY INIT CODE
/MAY BE ZEROED BY IT. USED TO DELETE F4 OUTPUT FILE WHEN CHAINING
/FROM COMPILER + OUTPUT DEV IS NOT SYS
	CDF	10
	TAD	(7604	/POINT TO 2ND OUT FILE THING
	DCA	X11
	TAD	(7611	/POINTER TO 3RD
	DCA	X10
	TAD	(-5	/LENGTH OF SUCH THINGS
	DCA	LTEMP
	TAD I	X10	/MOVE 3RD TO 2ND
	DCA I	X11	/FOR LOADER MAP FILE
	ISZ	LTEMP
	JMP	.-3
	TAD I	[7600	/WAS THERE A FIRST OUT FILE
	AND	NP17	/(BINARY OUT)*
	DCA	LTEMP
	TAD	OUTBLK	/GET FILE LENGTH
	AND	(377
	CLL RTL
	RTL
	CIA
	TAD	LTEMP	/COMBINE UNIT AND LEN
	DCA I	X10	/FOR FIRST INPUT FILE TO LOADER
	TAD	PASBLK	/STARTING BLOCK
	DCA I	X10
	DCA I	X10	/THAT'S THE END OF INPUT
	CDF	0
	TAD	ERRORS	/IF NO ERRORS
	SNA CLA
	ISZ	CHNSW	/SHOULD WE CHAIN?
	JMP I	(7605	/NO!!!
	ISZ I	(7746	/**
	CIF	10
	JMS I	USR
	6		/CHAIN
LDRBLK,	0		/FIRST BLOCK OF LOADER
/
PASBLK,	0		/FIRST BLOCK OF FILE PASSED
CHNSW,	0		/-1 TO ENABLE CHAIN LOADER
/
/	OUTPUT A BLOCK OF BINARY
/
OUTBLK,	0		/AT END OF PASS2, BECOMES
			/LENGTH OF BINARY FILE
	TAD	(OUCTL	/DEV HNDLR CONTROL WORD
	JMS I	(OUTDMP	/CALL THE HANDLER
	TAD	MOUBUF
	DCA	OUTPTR	/RESET BUFFER POINTER
	DCA	ABSOP	/FORCE NEW ABS OUTPUT CONTROL
	JMP I	OUTBLK
MOUBUF,	OUBUF-1
/
TYPCOD,	2500	/UNDEFINED
	0000	/ADDRESS
	3000	/XTERNAL
	0300	/COMMON
	2300	/SECTION
	-1	/?
	-1	/?
	7000	/8-M0DE SECTION
	3200	/8-MODE PAGE0 COMMON SECTION
	0600	/8-MODE FIELD1 SECTION
BORG,	0
	CDF	FLD0
	TAD	LOCTR1
	RTR
	RTR
	AND	[177
	TAD	(ESDBUF-1 /POINT INTO ESD TABLE
	DCA	LTEMP
	TAD I	LTEMP
	TAD	(4	/ADDRESS VALUE
	DCA	LTEMP
	CDF	FLD1
	TAD	LOCTR1
	AND	[7	/GET ADDR BITS ONLY
	DCA	BOTMP	/SAVE EM
	TAD I	LTEMP	/OLD HIGH VALUE BITS
	AND	[7
	CIA
	TAD	BOTMP	/COMPARE THEM
	SPA
	JMP	BOXIT	/NO UPDATE REQUIRED
	SNA CLA
	JMP	BOCHKL	/NO DIFFERENCE YET
	TAD	LOCTR1
	DCA I	LTEMP	/RESET TO NEW HIGH
	ISZ	LTEMP
	JMP	BOSETL	/SKIP OVER TEST
BOCHKL,	ISZ	LTEMP	/POINT TO LO-ORDER
	TAD I	LTEMP
	CIA CLL
	TAD	LOCTR2	/COMPARE LOW ORDERS
	SNL CLA
	JMP	BOXIT	/NO REPLACE
BOSETL,	TAD	LOCTR2
	DCA I	LTEMP
BOXIT,	CLA
	CDF	FLD0
	JMP I	BORG	/WHEW!
BOTMP=	EXTMP
	PAGE
NEWESD,	0
	TAD	ESDNO
	TAD	(-177	/CHECK LIMIT
	SPA CLA
	JMP	.+3
	JMS I	[ERMSG1	/TOO MANY
	3023		/*XS*
	ISZ	ESDNO	/BUMP COUNT
	TAD	PASSNO	/DON'T CHANGE TABLE AFTER PASS 1
	SMA CLA
	JMP I	NEWESD
	TAD	ESDNO
	TAD	(ESDBUF-1 /INDEX BUFFER
	DCA	ESDTMP
	CDF	FLD1
	TAD I	OLDN3	/GET POINTER TO THIS SYMBOL
	CDF	FLD0
	DCA I	ESDTMP
	TAD	ESDTMP
	TAD	[200
	DCA	ESDTMP	/NOW ADDRESS CHAR TABLE
	TAD	BUCKET
	DCA I	ESDTMP
	JMP I	NEWESD
ESDTMP=	EXTMP
/
/	RELOCATION CONTROL PSEUDO-OPS
/
ENTRX,	JMS I	[GETNAM	/NAME OF ENTRY POINT
	JMP	ESDERR
	JMS I	[LOOKUP	/FIND IT
	JMP	QENT	/UNDEFINED
	CLL RAR		/MUST BE USER ADDR TYPE
	SNA CLA
	TAD I	X10	/LOOK AT ESD
	AND	[7770
	SZA CLA		/IS IT RELOCATABLE?
	JMP	OKENT	/YES
QENT,	JMS I	[ERMSG	/NO MESSAGE ON PASS 1
	1105		/*IE*
OKENT,	JMS	NEWESD	/CREATE AN ENTRY FOR IT
	JMP I	[NEXTST
/
EXTRNX,	CLA STL RTL
	DCA	STYPE	/EXTERNS ARE TYPE 2
	JMS I	[GETNAM
	JMP	ESDERR
	JMS I	[LOOKUP
	JMS	CRESD	/IF UNDEFINED, DEFINE IT
	CLL RTR		/IF DEFINED, CHECK LEGALITY
	SZA CLA
ESDERR,	JMS I	[ERMSG
	0523		/*ES*
	JMP I	[NEXTST
/
	CLA IAC		/FIELD1 SECT=11
	IAC		/COMMZ SECT=10
SECT8X,	TAD 	[7
	JMP	COMMX+1
SECTX,	CLA IAC
COMMX,	TAD	(COMMN	/GET DESIRED CODE
	DCA	STYPE	/FOR SECTION TYPE
	JMS I	[GETNAM
	DCA	BUCKET	/IF NO NAME, BLANK COMMON
	JMS I	[LOOKUP
	JMP	NEWSCT	/UNDEFINED
	CIA		/OLD FRIEND
	TAD	STYPE	/SAME?
	SNA CLA
	JMP	SETSCT	/YUP, DO IT
	JMP	ESDERR
/
CRESD,	0
	JMS	NEWESD	/CREATE NEW ESD ENTRY
	CDF	FLD1
	TAD I	LTEMP	/SET TYPE CODE
	AND	[7700
	TAD	STYPE
	DCA I	LTEMP
	ISZ	LTEMP
	TAD	ESDNO
	CLL RTL		/ESD NO TO SYMBOL VLAUE
	RTL
	DCA I	LTEMP	
	CDF	FLD0
	JMP I	CRESD
/
NEWSCT,	JMS	CRESD	/CREATE AN ESD
SETSCT,	JMS I	(BORG	/ADJUST LOC CTR'S
	CDF	FLD1
	TAD I	X10	/GET NEW LOC CTR VALUE
	DCA	LOCTR1
	TAD I	X10
	DCA	LOCTR2	/LOW LOC CTR
	CDF	FLD0
	JMP	PUTORG
/
ORGX,	JMS I	(ADRGET	/GET ORG EXPR
	JMS I	(BORG
	TAD	EXPVAL+1
	AND	[7770	/DOES IT HAVE AN ESD?
	SNA CLA
	TAD	LOCTR1	/IF NOT, KEEP CURRENT ESD
	AND	[7770
	TAD	EXPVAL+1
	DCA	LOCTR1	/RESET PC
	TAD	EXPVAL+2
	DCA	LOCTR2
PUTORG,	TAD	PASSNO	/OUTPUT ON PASS 2 ONLY
	SZA CLA
	JMP I	[NEXTST
	DCA	ABSOP	/CLEAR ABS OUTPUT SW
	CLA STL RTL
	JMS I	(FULCHK	/ROOM FOR MORE?
	TAD	LOCTR1
	RTR
	RTR		/GET ESD
	AND	[177
	TAD	(TTORG
	DCA I	OUTPTR
	TAD	LOCTR1
	AND	[7	/FIELD BITS
	DCA I	OUTPTR
	TAD	LOCTR2	/ADDRESS
	DCA I	OUTPTR
	JMS I	(FULCHK
	JMP I	[NEXTST
	PAGE	/>
/
/	VARIOUS PSEUDO-OP HANDLERS
/
LSTONX,	TAD	SYONLY		/ENABLE LISTING UNLESS SYM MAP ONLY
LSTOFX,	DCA	LISTSW
	JMP I	[NEXTST
/
DECX,	CLA IAC
OCTALX,	DCA	RADIX
	JMP I	[NEXTST
/
TEXTX,	JMS I	[GETCHR	/GET DELIMITER
	JMP I	[NEXTST	/NULL STMT
	CIA
	DCA	EXTMP	/SAVE - DELIM
LOOP6B,	JMS	GETCHT	/GET HIG ORDER CHAR
	JMP I	[NEXTST
	JMS I	[R6L	/SHIFT IT UP
	DCA	LTEMP	/SAVE HALF
	JMS	GETCHT	/GET LOWER CHAR
	JMP	OUTTXT	/GO PUT LAST
	TAD	LTEMP	/PUT 2 CHARS TOGETHER
	JMS I	[OUTWRD	/OUTPUT WORD
	JMP	LOOP6B	/LOOP
OUTTXT,	TAD	LTEMP	/PUT OUT HALF WORD
	JMS I	[OUTWRD	/OR ZERO WORD
	JMP I	[NEXTST
GETCHT,	0		/GET CHAR FOR TEXT STMT
	ISZ	NCHARS	/BUMP COUNT
	SKP
	JMP I	GETCHT	/END OF TEXT
	TAD I	CHRPTR	/GET CHAR
	DCA	BUCKET	/SAVE IT
	TAD	BUCKET	/IS IT THE DELIM ?
	TAD	EXTMP
	SNA CLA
	JMP I	GETCHT	/YES, RETURN NO SKIP
	ISZ	GETCHT	/BUMP RETURN
	TAD	BUCKET	/GET CHAR
	AND	[77	/LOW 6 BITS
	JMP I	GETCHT	/RETURN
/
/	CONDITIONAL ASSEMBLY HANDLERS
/
IFNZRX,	CLA CMA
IFZROX,	JMS	GETCON	/GET CONDITION EXPR
	TAD	EXPVAL+1 /HIGH ORDER
	AND	[7
	SNA
	TAD	EXPVAL+2 /LOW ORDER
SWTCH,	SNA CLA
	JMP	TRUE	/PRESENT CONDITION OF ASMOF IS OK
FALSE,	TAD	ASMOF	/GOTTA REVERSE IT
	CMA
	DCA	ASMOF	/THAT DOES IT
TRUE,	CDF	FLD0
	JMS I	[GETCHR
	JMP	BADCND	/FORGOT THE ANGLE
	TAD	[-240	/IGNORE BLANK, IF ANY
	SNA
	JMP	TRUE	/TRY AGAIN
	TAD	(240-274
	SNA CLA
	JMP I	(ASMBL	/GO FROM HERE
	JMS I	[BACK1	/LET SOMEONE ELSE WORRY ABOUT IT
	JMP	BADCND
/
GETCON,	0
	DCA	ASMOF	/SET INITIAL TRUTH
	JMS I	[EXPR	/COLLECT EXPR
	JMP	OKCND	/BAD MAY MEAN GOOD
BADCND,	JMS I	[ERMSG	/BUT GOOD MEANS BAD
	1103		/*IC*
	DCA	ASMOF	/ENABLE ASSEMBLY
	JMP I	(ASMBL
OKCND,	TAD	EXPSW	/WAS THERE AN EXPR, AT LEAST?
	SNA CLA
	JMP I	GETCON	/YES
	JMP	BADCND
/
IFNEGX,	CLA CMA
IFPOSX,	JMS	GETCON
	CLA CLL IAC RTL	/4
	AND	EXPVAL+1 /SIGN OF EXPR
	JMP	SWTCH	/GO FROM THERE
/
IFNDFX,	CLA CMA
IFREFX,	DCA	ASMOF
	JMS I	[GETNAM	/GET SYMBOL NAME
	JMP	BADCND	/GOTTA GIVE SOMETHING
	JMS I	[FIND	/IS IT KNOWN TO US?
	JMP	FALSE	/NOT REFERENCED YET
	SNA CLA		/SKIP IF DEFINED
	DCA	ASMOF	/ELSE ASSEMBLE
	JMP	TRUE
IFSWX,	CLA CMA
IFNSWX,	DCA	ASMOF
	TAD	(7642	/ADDRESS OF OPTION WORDS
	DCA	WORD2	/A TEMP
	JMS I	(LETTER	/ALLOW LETTER
	JMP	.+4	/AC BETWEEN 1 AND 32
	JMS I	(DIGIT	/OR NUMBER
	JMP	BADCND	/ALL ELSE IS BAD
	TAD	(33	/MAKE 0 = Z+1
	ISZ	WORD2	/BUMP POINTER
	TAD	(-14	/IS IT IN THIS WORD?
	SMA SZA
	JMP	.-3	/NO, POINT TO NEXT
	CIA
	CMA STL		/BIT COUNT AWAY FROM LINK
	DCA	WORD1
	RAL		/SHIFT
	ISZ	WORD1	/COUNT
	JMP	.-2
	CDF	10	/OPTIONS FIELD
	AND I	WORD2	/GET SELECTED BIT
	JMP	SWTCH	/AND TEST IT
/
ZBLKX,	JMS I	(ADRGET	/EVALUATE EXPR
	TAD	EXPVAL+2
	CIA
	DCA	ZBCNT	/HOLD COUNT
	TAD	LISTSW	/SAVE LISTSWITCH
	DCA	ZBTMP
	JMS I	[OUTWRD	/PUT A WORD
	DCA	LISTSW	/NO LIST AFTER FIRST
	ISZ	ZBCNT	/COUNT THEM
	JMP	.-3	/MORE
	TAD	ZBTMP	/RESTORE
	DCA	LISTSW	/LISTING
	JMP I	[NEXTST
ZBCNT=	EXTMP
ZBTMP=	EXTMP2
	PAGE
	PTP=20
	DCB=7760
	INFLD=INCTL&70	/GET FIELD OF INPUT BUFFER
	OUFLD=OUCTL&70	/DITTO OUTPUT BUFFER
IN7400,	7400
NINCTL,	INCTL+1
NINREC,	INRECS
IOPEN,	0
	TAD	(7617
	DCA	INFPTR	/RESET FILE POINTER
	JMS	INNEWF	/FETCH NEW HNDLR, ETC
			/WHILE USR IS STILL IN CORE
	CLA CMA
	DCA	INCHCT	/FORCE A READ ON NEXT CHAR
	JMP I	IOPEN
ICHAR,	0
IN7600,	7600
INCHAR,	CDF INFLD
	ISZ	INJMP	/BUMP THREE-WAY UNPACK SWITCH
	ISZ	INCHCT
INJMPP,	JMP	INJMP
	TAD	INEOF
	SZA CLA		/DID LAST READ GIVE EOF ?
GETNEW,	JMS	INNEWF	/OPEN A NEW INPUT FILE
	TAD	INCTR
	CLL
	TAD	NINREC
	SNL
	DCA	INCTR	/RESTORE INCR IF NOT OVERFLOWED
	SZL		/IS THIS THE LAST READ?
	ISZ	INEOF	/YES - SET END-OF-FILE FLAG
	CLL CML CMA RTR	/MAKE CONTROL WORD
	RTR		/FROM THE AMOUNT OF THE OVERFLOW
	RTR		/(IF ANY) AND THE STANDARD CNTRL WD
	TAD	NINCTL
	DCA	INCTLW
	CDF
	JMS I	INHNDL	/CALL THE DEVICE HANDLER
INCTLW,	0
INBUFP,	INBUF
INREC,	0
	JMP	INERRX	/SOME KIND OF HANDLER ERROR
INBREC,	TAD	INREC
	TAD	NINREC
	DCA	INREC	/UPDATE THE RECORD NUMBER
	TAD	INCTLW
	AND	IN7600
	CLL RAL
	TAD	INCTLW
	AND	IN7600
	CMA
	DCA	INCHCT	/COMPUTE THE NEW CHARACTER COUNT
	TAD	INJMPP
	DCA	INJMP	/RESET THE CHARACTER SWITCH
	TAD	INBUFP
	DCA	INPTR	/AND THE WORD POINTER
	JMP	INCHAR	/MAKE BELIEVE THIS NEVER HAPPENED
INERRX,	ISZ	INEOF	/EITHER AN END-OF-FILE OR A BADDIE
	SMA CLA		/WHICH TYPE WAS IT ?
	JMP	INBREC	/END OF FILE - RESUME PROCESSING
	JMP I	[IOERR	/BADDIE, GIVE ERROR MESSAGE
INJMP,	HLT		/THIS IS THE 3 WAY CHARACTER SWITCH
	JMP	ICHAR1
	JMP	ICHAR2
	TAD	INJMPP
	DCA	INJMP
	TAD I	INPTR
	AND	IN7400
	CLL RTR
	RTR		/COMBINE HIGH-ORDER FOUR BITS OF
	TAD	INCTLW
	RTR		/THE 2 WORD TO FORM THE 3RD CHAR
	RTR
	ISZ	INPTR
	JMP	INCOMN
ICHAR2,	TAD I	INPTR
	AND	IN7400
	DCA	INCTLW	/SAVE THE HI ORDER BITS FOR THE 3RD
	ISZ	INPTR	/BUMP THE WORD POINTER
ICHAR1,	TAD I	INPTR
INCOMN,	AND	(377
	TAD	(-232
	SNA		/IS THE CHARACTER A ^Z?
	JMP	GETNEW	/YES - GET A NEW FILE
	TAD	(232	/RESTORE THE CHARACTER
	CDF
	JMP I	ICHAR	/AND RETURN
INFPTR,	7617
INEOF,	1		/PARAMETERS ARE SET UP SO THAT
INCHCT,			/IOPEN IS UNNECESSARY.
INNEWF,	-1
	TAD	NINDEV
	DCA	INHNDL	/INITIALIZE HANDLER ADDRESS
	CDF	10
	TAD I	INFPTR	/GET NEXT CD INPUT FILE ENTRY
	CDF
	SNA		/ANY MORE?
	JMP I	(ENDX	/NO MORE INPUT
	CIF 10
	JMS I	USR
	1		/ASSIGN, FETCH HANDLER
INHNDL,	0
	JMP I	[IOERR	/HUH?
	CDF 10
	TAD I	INFPTR
	AND	(7760	/GET LENGTH PART OF WORD
	SZA		/LENGTH OF 0 MEANS LENGTH GE 256
	TAD	[17		/ADD HIGH ORDER BITS
	CLL CML RTR
	RTR
	DCA	INCTR	/STORE LENGTH OF FILE
	ISZ	INFPTR
	TAD I	INFPTR
	CDF
	DCA	INREC	/STARTING RECORD NUMBER OF FILE
	ISZ	INFPTR
	DCA	INEOF	/ZERO END-OF-FILE FLAG
	JMP I	INNEWF
INCTR,	0
INPTR,	0
OUFNAM,	0;0;0;0		/OUTPUT FILE NAME
NINDEV,	INDEVH
	PAGE
OOPEN,	0
	TAD	OUFILE	/INCR OUTPUT FILE POINTER
	TAD	(5
	DCA	OUFILE
	CDF	10
	TAD I	OUFILE	/GET DEVICE CODE, LEN
	DCA	OUELEN	/HOLD IT A MO
	JMS I	(OFNAME	/GET FILE NAME INTO FIELD 0
	TAD	OUELEN	/CHECK FOR NULL FILE
	SNA CLA
	JMP	ONOFIL	/INHIBIT OUTPUT
	JMS	GETUSR	/LOAD USR IF NOT ALREADY IN
	TAD	OUNAME	/RESET ENTER CALL
	DCA	OUBLK
	TAD	NOUDEV
	DCA	OUHNDL
	TAD	OUELEN	/THE UNIT
	CIF 10
	JMS I	USR
	1		/ASSIGN, FETCH HANDLER
OUHNDL,	0		/OUTPUT DEVICE HANDLER ENTRY
	JMP I	[IOERR	/HUH?
	TAD	OUELEN	/UNIT AGAIN
	CIF	10
	JMS I	USR
	3		/ENTER OUTPUT FILE
OUBLK,	OUFNAM		/REPLACED WITH STARTING BLOCK
OUELEN,	0		/REPLACED WITH LENGTH OF HOLE
	JMP I	[IOERR	/YOU BLEW IT!!!
	DCA	OUCCNT
	DCA I	(OUTINH	/ZERO OUTPUT INHIBIT FLAG
	JMS I	(OUSETP
	ISZ	OOPEN
	JMP I	OOPEN
ONOFIL,	ISZ I	(OUTINH
	JMP I	OOPEN
OUTDMP,	0
	DCA	OUCTLW	/STORE THE CONTROL WORD
	TAD	OUCCNT
	SNA
	ISZ	OUCTLW
	TAD	OUBLK
	DCA	OUREC	/COMPUTE STARTING BLOCK
	TAD	OUCTLW
	JMS I	[R6L
	AND	[17	/COMPUTE THE NUMBER OF RECORDS
	TAD	OUCCNT	/UPDATE SIZE OF FILE
	DCA	OUCCNT
	TAD	OUCCNT
	CLL CML
	TAD	OUELEN
	SNL SZA CLA	/EXCEED GIVEN LENGTH ?
	JMP I	[IOERR	/YES - ERROR
	CDF
	JMS I	OUHNDL
OUCTLW,	0
LOUBUF,	OUBUF
OUREC,	0
	JMP I	[IOERR
	JMP I	OUTDMP
OCLOSE,	0
	JMS	GETUSR	/ENSURE USR IN CORE
	IFNZRO	RALF	<
	TAD	PASSNO
	SZA CLA
	JMP	.+6
	TAD	(377
	JMS I	(FULCHK	/DUMP LAST BLOCK
	TAD	OUCCNT	/SAVE FILE LENGTH
	DCA I	(OUTBLK	/FOR CHAIN
	JMP	NODUMP	>
	JMS I	(OTYPE
	AND	(770
	TAD	(-PTP	/CHECK FOR PAPER TAPE PUNCH OUTPUT
	SZA CLA		/AND SKIP ^Z OUTPUT IF TRUE
	TAD	(232	/OUTPUT A ^Z
	JMS I	[OCHAR
FILLLP,	JMS I	[OCHAR
	JMS I	(OTYPE	/GET TYPE OF OUTPUT DEVICE
	SPA CLA
	TAD	[100
	TAD	[77
	AND I	(OUDWCT
	SZA CLA		/UP TO THE BOUNDARY YET?
	JMP	FILLLP	/NO - FILL WITH ZEROS
	TAD I	(OUDWCT	/GET DOUBLEWORD COUNT LEFT
	TAD	(OUCTL&3700
	SNA		/A FULL WRITE LEFT?
	JMP	NODUMP	/YES DON'T DO IT
	TAD	(4000+OUFLD /PUT IN FIELD AND WRITE BITS
	JMS	OUTDMP
NODUMP,	CIF CDF 10
	TAD I	OUFILE
	CDF
	JMS I	USR
	4		/CLOSE THE OUTPUT FILE
OUNAME,	OUFNAM		/POINTER TO OUTPUT FILE NAME
OUCCNT,	0
	JMP I	[IOERR	/ERROR WHILE CLOSING - BAD!!
	JMP I	OCLOSE	/ALL DONE
NOUDEV,	OUDEVH
/
/	LOAD USR IF NOT IN CORE ALREADY
/
GETUSR,	0
	TAD	USR	/CURRENT CALL ADDR
	SMA CLA
	JMP I	GETUSR	/WE GOT IT
	CIF	10
	JMS I	USR	/THE ANSWERING SERVICE
	10		/CALLS THE SR
	TAD	[200
	DCA	USR	/RESET THE CALL ADDRESS
	JMP I	GETUSR	/JES FINE
	PAGE
FULCHK,	0
	IFNZRO	RALF	<
/
/	IF THE RELOCATABLE BINARY OUTPUT
/	BLOCK IS FULL (WITHIN THE CONTENTS OF THE AC)
/	FILL THE REST WITH NOP CODES AND OUTPUT THE
/	BLOCK.
/
	TAD	OUTPTR
	TAD	KOUBUF
	SPA CLA
	JMP I	FULCHK
FULLUP,	TAD	OUTPTR
	TAD	KOUBUF
	SMA CLA
	JMP	.+4
	CLA IAC
	DCA I	OUTPTR
	JMP	FULLUP
	JMS I	(OUTBLK
	JMP I	FULCHK	
KOUBUF,	-OUBUF-377	>
/
/
/	GET SIGN CHARACTER IF ANY
/	BUMP LASTOP IF MINUS
/
GETSGN,	0
	JMS I	[GETCHR
	JMP I	GETSGN
	TAD	(-255	/MINUS?
	SNA
	ISZ	LASTOP
	SZA
	CLL CMA RAR	/IF IT WAS PLUS, BECOMES 0
	SZA CLA		/SKIP IF PLUS OR MINUS
	JMS I	[BACK1	/OTHERWISE PUT IT BACK
	JMP I	GETSGN
/	AS PER RICHIE LARY
/
/	SINGLE AND DOUBLE PRECISION
/	FLOATING POINT INPUT
/
/
EX,	TAD	M3
FX,	TAD	M3
	DCA	DESW	/STORE LENGTH
	TAD	(-7
	JMS	CLEAR	/CLEAR FAC+OP
	DCA	LASTOP
	JMS	GETSGN	/GET SIGN
	STA		/CLA CMA
	DCA	DPSW	/SET NO DP
GETD,	DCA	DCNT
	JMS I	(DIGIT	/GET A DIGIT
	JMP	LOOKP	/NO
	DCA	OTEMP	/SAVE IT
	JMS I	(FMPTEN	/MULT FAC*10
	JMS	CLEAR
	TAD	OTEMP
	SZA
	JMS I	(FAD	/ADD DIGIT TO FAC IF NOT= 0
	TAD	DPSW
	CMA
	TAD	DCNT	/BUMP IF FP SEEN
	JMP	GETD
LOOKP,	JMS I	[GETCHR
	JMP	OVER	/DONE
	TAD	(-256
	SNA
	JMP	DECPT
	TAD	(256-304
	CLL RAR
	SNA CLA
	JMP I	(EXPON	/E OR D
DEXERR,	JMS I	[ERMSG
	0620		/FP
	JMP	NOTNEG
DECPT,	ISZ	DPSW
	JMP	DEXERR	/2 PERIODS
	JMP	GETD
/
OVER,	TAD	DCNT	/EXPON COMES HERE W EXP IN AC
	SNA
	JMP	NOSCAL	/NO SCALING NEEDE
	CLL
	SMA
	CIA	CML	/SIGN IN LINK,MAGNITUDE IN AC
	DCA	DCNT	/AS A COUNT
	SNL
	TAD	(TENTH-TEN	/OFFSET KLUDGE
	DCA	OTEMP
SCALUP,	TAD	OTEMP
	JMS I	(FMPTEN	/MULT BY 10.0 OR 0.1
	ISZ	DCNT
	JMP	SCALUP
NOSCAL,	JMS	CLEAR
	STL RAR
	DCA	OP+5	/ROUNDING CONSTANT
	JMS I	(ADD
	TAD	AC
	SZA CLA
	JMS I	(NORM	/WATCH IT!
	DCA	AC+5
	TAD	LASTOP
	SNA CLA		/SIGN -?
	JMP	NOTNEG	/NO
	TAD	(AC+5
	JMS I	(SETUP
ACNGLP,	RAL
	TAD I	P	/NEGATE FAC
	CLL CIA
	DCA I	P
	STA
	TAD	P
	DCA	P
	ISZ	CT
	JMP	ACNGLP
NOTNEG,	JMS	CLEAR	/SET UP X10
	TAD I	X10
	JMS I	[OUTWRD
	ISZ	DESW	/OUTPUT #
	JMP	.-3
	JMP I	[NEXTST
CLEAR,	0		/AC MAY NOT BE 0
	TAD	(-7
	DCA	CT
	TAD	(OPX-1
	DCA	X10
	DCA I	X10
	ISZ	CT
	JMP	.-2
	JMP I	CLEAR
	DCNT=FULCHK
	DPSW=NCTMP
	DESW=OPCODE
	PAGE
	OVBUFR=.
FAD,	0		/FLOATING ADD DIGIT IN AC
	DCA	OP
	TAD	(13
	DCA	OPX
ALNLP,	TAD	OPX
	CIA
	TAD	ACX
	SNA		/ALIGNED?
	JMP	GOADD	/YES
	SMA CLA
	TAD	(OPX-ACX
	JMS	RSHFT	/NO-SHIFT 1 OF THEM RIGHT 1
	JMP	ALNLP	/TRY AGAIN
GOADD,	JMS	ADD	/ADD FRACTIONS
	JMS	NORM	/NORMALIZE RESULT
	JMP I	FAD	/RETURN
/
RSHFT,	0		/SHIFT RIGHT
	TAD	(ACX	/DEFAULT IS FAC
	JMS	SETUP
	ISZ I	P	/BUMP EXPONENT
RSLP,	ISZ	P
	TAD I	P
	RAR
	DCA I	P
	ISZ	CT
	JMP	RSLP
	JMP I	RSHFT
/
ADD,	0		/ADD TO FAC
	TAD	(OP+5
	DCA	PP2
	TAD	(AC+5
	JMS	SETUP
ADDLP,	RAL		/CARRY
	TAD I	PP2
	TAD I	P
	DCA I	P	/ADD ONE WORD
	STA
	TAD	P	/COMPLEMENT LINK
	DCA 	P
	STA
	TAD	PP2	/COMPLEMENT LINK
	DCA	PP2
	ISZ	CT
	JMP	ADDLP
	JMP I	ADD
NORM,	0		/NORMALIZE FAC
	TAD	AC
	SPA CLA		/CHECK FOR OVERNORMALIZATION
	JMS	RSHFT	/AND CORRECT
NORMLP,	STL	RTR
	AND	AC
	SZA	CLA	/NORMALIZED?
	JMP I	NORM	/YES
	TAD	(AC+5
	JMS	SETUP
LSLP,	TAD I	P
	RAL		/LEFT SHIFT
	DCA I	P	/FAC 1 BIT
	STA	CML	/COMPLEMENT LINK
	TAD	P
	DCA	P
	ISZ	CT
	JMP	LSLP
	STA
	TAD	ACX	/BUMP EXP
	DCA	ACX	/DOWN 1
	JMP	NORMLP
FMPTEN,	0		/FLTG MULTIPLY BY 10.0 OR .1
	TAD	(TEN
	JMS	SETUP
	TAD	AC
	SNA	CLA	/AC=0 MEANS RESULT=0
	JMP I	FMPTEN
	TAD I	P
	TAD	ACX	/FUDGE FAC
	DCA	ACX	/EXPONENT
	TAD	(MUX
	DCA	X11
	TAD	(ACX
	DCA	SETUP
	TAD	(OPX
	DCA	X10
	DCA	MUX	/CLEAR MULT TEMP EXP
MPLP1,	ISZ	SETUP
	TAD I	SETUP	/MOVE FAC
	DCA I	X10	/TO OP
	DCA I	SETUP	/CLEAR FAC
	ISZ	P
	TAD I	P	/MOVE MULTIPLIER
	DCA I	X11	/TO MULT TEMP
	ISZ	CT
	JMP	MPLP1
/
MPLP2,	TAD	(MUX-ACX
	JMS	RSHFT	/SHIFT MULT TEMP RIGHT 1
	SZL
	JMS	ADD	/ADD IF LOW ORDER BIT WAS 1
	JMS	RSHFT	/SHIFT FAC RIGHT
	TAD	MU+5
	SZA CLA		/12 SUCCESSIVE 0 BITS
	JMP	MPLP2	/IN MULTIPLIER MEANS DONE
	JMS	NORM
	JMP I	FMPTEN
/
SETUP,	0		/COMMON CODE
	DCA	P
	TAD	(-6
	DCA	CT
	CLL
	JMP I	SETUP
/
MUX,	0		/MULT TEMP
MU,	ZBLOCK 6
	CT=CPTMP
	P=EXTMP
	PP2=PAGEN
	PAGE
	IFNZRO	RALF	<
ESDBUF,	PNDL+6		/ESD ENTRY FOR SECTION #MAIN
	PNDL		/DITTO FOR BLANK COMMON
	ZBLOCK	376	/FILL TO 400 LOCS
/
/	BEGIN OF PASS 2:
/	DUMP EXTERNAL SYMBOL DICTIONARY
/	DURING PASSES 2 AND 3, THIS IS INPUT BUFFER
/
DMPESD,	CLA CLL CMA RAL	/-2
	DCA	EXTMP2	/PASS CONTROL
	TAD	(3	/RALF OUTPUT IDENTIFIER
	DCA I	OUTPTR
	TAD	VERS
	DCA I	OUTPTR	/THIS MAKES 6-WORD ENTRIES
	TAD DPFLG	/4000=NEED DP HARDWARE
	DCA I	OUTPTR	/EXACTLY FILL A BLOCK
	DCA I	OUTPTR
ESDSCN,	TAD	(ESDBUF-1
	DCA	X10	/POINT TO POINTERS
	TAD	(ESDBUF+177
	DCA	X12	/POINT TO INITAIL CHARS
	TAD	ESDNO
	CIA
	DCA	EXTMP
ESDLUP,	TAD	(-3
	DCA	LTEMP	/NAME LENGTH COUNT
	TAD	(EQUN-1	/WHERE WE'LL KEEP THE NAME
	DCA	X13
	TAD I	X10	/GET POINTER
	DCA	X11
	TAD I	X12	/GET FIRST CHAR
	SNA		/BLANK BECOMES #
	TAD	(43
ESDNLP,	JMS I	[R6L
	DCA	EQUN+2
	CDF	FLD1
	TAD I	X11	/GET NEXT PAIR FROM SYMBOL TABLE
	DCA	EQUN+3	/HOLD IT
	CDF	FLD0
	TAD	EQUN+3
	JMS I	[R6R	/GET LEFT CHAR
	TAD	EQUN+2	/COMBINE THEM
	DCA I	X13
	TAD	EQUN+3	/GET RIGHT HALF OF PAIR
	AND	[77
	ISZ	LTEMP
	JMP	ESDNLP
	AND	[37	/DROP FORCE BIT FROM TYPE
	DCA	EQUN+3
	CDF	FLD1
	TAD I	X11	/HIGH VALUE
	DCA	EQUN+4
	TAD I	X11	/LOW VALUE
	DCA	EQUN+5
	CDF	FLD0
	TAD	EXTMP2	/WHAT PASS IS THIS?
	RAR		/LINK 0 IF FIRST, 1 IF SECOND
	SNL CLA
	JMP	NOENTS	/FIRST, ENTRYS NOT OUTPUT
	TAD	EQUN+3	/OUTPUT ENTRIES ONLY ON 2ND
	CLL RAR
	SNA CLA
	SNL
	JMP	ESDLND	/NO GO
	JMP	ESDOUT	/YES, PUT IT
NOENTS,	TAD	EQUN+3	/EXT, COMM, OR SCTN
	CLL RAR
	SNA		/SKIP IF OK
	JMP	ESDLND	/UNDEFINED OR ENTRY
	RAR
	SNA CLA
	JMP	ESDOUT	/IF EXTERN, DO IT
	TAD	EQUN+4	/IF SECTION, CHECK
	AND	[7	/THAT LENGTH
	SNA		/IS NON-ZERO
	TAD	EQUN+5
	SNA CLA
	JMP	ESDLND	/ZERO LEN JUST GETS IN THE WAY
ESDOUT,	TAD	(EQUN-1
	DCA	X13
	TAD	(-6
	DCA	LTEMP
	TAD I	X13	/GET OUTPUT WORD
	DCA I	OUTPTR
	ISZ	LTEMP
	JMP	.-3	/6-WORD ENTRIES
	TAD	OUTPTR
	TAD	OUTBUF
	SPA CLA
	JMP	ESDLND	/NOT END OF BLOCK YET
	JMS I	(OUTBLK
	TAD	(3
	DCA I	OUTPTR
	DCA I	OUTPTR
	DCA I	OUTPTR
	DCA I	OUTPTR
ESDLND,	ISZ	EXTMP	/GO THRU ESD LIST
	JMP	ESDLUP
	ISZ	EXTMP2	/WHOLE LIST TWO PASSES
	JMP	ESDSCN
	TAD	(-6	/THEN STORE END-OF-ESD
	DCA	LTEMP
	DCA I	OUTPTR
	ISZ	LTEMP
	JMP	.-2
	TAD	(377	/FORCE BLOCK OUTPUT
	JMS I	(FULCHK
	CDF	FLD1	/THEN DEFAULT ORG
	TAD I	(LMAIN	/IF MAIN LEN .NE. 0
	AND	[7
	SNA
	TAD I	(LMAIN+1
	CDF	FLD0
	SNA CLA
	JMP I	(RESET	/FIRST SECTION WILL GET IT
	TAD	(TTORG+1 /ORG TO ZERO OF MAIN
	DCA I	OUTPTR
	DCA I	OUTPTR
	DCA I	OUTPTR
	JMP I	(RESET
OUTBUF,	1001
	PAGE	/>
/
/       INITIALIZATION CODE
/
BEGIN,  JMP     CHNIN   /IF ENTERED BY CHAIN
GCMND,  CIF     10	/IF ENTERED BY .R, ETC
        JMS I   USR     /USR IS LEFT OVER
        5               /DECODE
	IFZERO	RALF	<
        620             /DEFAULT EXT = .FP>
	IFNZRO	RALF	<
	2201		/DEFAULT EXT = .RA>
	DCA I	(RETSYS		/NO NEED FOR IT IF NOT CHAINED
CHNIN,	JMS I	(7607
	4100		/TEMP WRITE OUT OVERLAY
	6600		/NOW AT 6600
	40		/TO SYS SCRATCH BLK 40
	JMP I	(7605	/ERROR
	CDF	10
        IFNZRO  RALF    <
        TAD I   [7600   /BIN FILE UNIT
        AND     NP17
        SNA             /IS THERE ONE?
	JMP	DEFBIN	/NO, SET DEFAULT
        TAD     (7757   /POINT TO DEV CTRL WORD
        DCA     WORD1
        TAD I   WORD1
        SPA CLA
        JMP     OKBIN   /FILE-STRUCTURED, OK
        CDF     0
        JMS I   (PRTXT  /TYPE MESSAGE
        TXBBIN-1
        -TXBLN
        JMS I   [CRLF
        JMP     GCMND   /TRY AGAIN
/
DEFBIN,	CLA IAC		/DEFAULT BIN UNIT IS SYS
	DCA I	[7600	/SET UNIT
	TAD	[7600
	DCA	X10	/SET POINTER
	TAD	(0617	/FO
	DCA I	X10
	TAD	(2224	/RT
	DCA I	X10
	TAD	(2216	/RN
	DCA I	X10	/FORTRN.
	DCA I	X10
	CDF	0
	JMP I	(NOEXT	/NOW, OPEN THE FILE>
OKBIN,	CDF 0		/HAVE TO GO TO ANOTHER PAGE
	JMP I	(NOKBIN		/ONLY SO MANY PATCHES TO A PAGE
GBIN,	CDF	10
	TAD I (7644
	AND (20
	SNA CLA
	ISZ SYONLY	/=NO SLASH T
	CDF	0
	JMS I	(NEW	/**SEE IF NEED 2 PG HANDLER
	7600
	JMS I	(OOPEN
	DCA	BFILE
	IFNZRO	RALF	<
	TAD	R41	/L OR G SWITCH**
	CDF	10
	AND I	(7643	/TEST /L  OR /G SWITCH
	CDF	0
	SNA CLA		/**
	JMP	KCHN	/KILL CHAIN, IT'S SET
	CIF	10
	CLA IAC		/UNIT IS SYS
	JMS I	USR
	2		/LOOKUP
LBLK,	LDRNAM		/LOADER.SV
R41,	41		/**
	JMP	KCHN	/NO FIND, NO CALL
	TAD	LBLK	/STARTING BLOCK
	DCA I	(LDRBLK	/FOR CHAIN
	TAD I	(OUBLK	/OUTPUT STARTING BLOCK
	DCA I	(PASBLK	/SAVED FOR CHAIN TO LOADER
	CLA CMA		/ENABLE CHAIN
KCHN,	DCA I	(CHNSW	/OR KILL IT, WHATEVER>
	JMS I	(INCHK	/NOW CHECK INPUT DEVICES FOR 2 PG HANDLERS
	JMS I	(INNEWF	/GET INPUT HANDLER
	CLA CMA
	DCA I	(INCHCT	/SET INITIAL COUNT
	TAD	NP7700
	DCA	USR	/FROM NOW ON, USE THE HIGH CALL
	JMS I	(NEW
	7605		/CHECK LIST DEV TOO**
	CDF	10
	TAD I	(7611	/LST FILE EXT
	SNA
	TAD	(1423	/LS DEFAULT
	DCA I	(7611
	TAD I	(7666	/GET DATE
	DCA	WORD1
/
/	MOVE SYMBOL TABLE TO ITS PROPER LOCATION
/
	TAD	(1777
	DCA	X10	/LOADED ADDRESS OF SYMBOL TABLE
	CLA CMA
	DCA	X11	/WE MOVE IT TO ASSEMBLED ADDRESS
	TAD	(-FREE	/LENGTH OF SYMBOL TABLE
	DCA	WORD2	/SET COUNT
	TAD I	X10
	DCA I	X11	/THIS SAVES SWAPS OF USR
	ISZ	WORD2
	JMP	.-3
	CDF	0
	JMP I	(GDATE	/CHECK FOR FPP PRESENCE**
	PAGE
/
/	PUT THE DATE INTO THE PAGE HEADING
/
GDATE,	TAD	(1000
	DCA I	(7746	/SET NO-RESTART BIT
			/PUT VERNUM IN TITLE LINE
	TAD VMSG
	DCA I (VMTXT
	TAD	VMSG+1	/PATCH LEVEL
	DCA I	(VMTXT+1
	DCA	OCNT	/CLEAR OCNT
	TAD	WORD1	/RE-GET DATE
	SNA
	JMP I	(NEWLIN	/GOLLY, AND ALL THIS CODE WASTED
	AND	(370
	CLL RTR
	RAR
	TAD	(-12
	SPA
	JMP	.+3
	ISZ	OCNT
	JMP	.-4
	TAD	(72	/60+12
	DCA	OTEMP
	TAD	(TITDAT-1
	DCA	X11
	TAD	OCNT
	JMS I	(R6L
	SZA
	TAD	(6000
	TAD	OTEMP
	DCA I	X11
	TAD	WORD1
	AND	(7400	/MONTH
	JMS I	(R6L
	TAD	(MONTHS-3
	DCA	X10
	TAD I	X10
	DCA I	X11
	TAD I	X10
	DCA I	X11
	DCA	OCNT
	TAD	WORD1
	AND	[7
	DCA	OTEMP
	TAD I	(7777
	AND	(600
	RTR CLL
	RTR
	TAD	OTEMP
	TAD	(106
	TAD	(-12
	SPA
	JMP	.+3
	ISZ	OCNT
	JMP	.-4
	TAD	(72
	DCA	OTEMP
	TAD	(5560
	TAD	OCNT
	DCA I	11
	TAD	OTEMP
	JMS I	(R6L
	TAD	(40
	DCA I	X11
	JMP I	(NEWLIN
VMSG,	VNUM&70^10+VNUM&707+6060
	PATCH&77^100+40
	IFNZRO	RALF	<
LDRNAM,	TEXT	"LOAD@@SV"
TXBBIN,	TEXT	"BIN OUT DEV NOT FILE-STRUCTURED"
TXBLN=	.-TXBBIN	>
MONTHS,	TEXT	"-JAN-FEB-MAR-APR-MAY-JUN-JUL-AUG-SEP-OCT-NOV-DEC"
	PAGE
/PAGE FOR NEW CODE REQUIRED FOR OS/8 FORTRAN
NEW,	0
	TAD	NT2	/CHECK IF ALREADY CHECKED
	SZA	CLA
	JMP 	NEWDON
	TAD I	NEW	/NO. GET THE DEV TO CHECK
	DCA	NTEMP
	CDF	10
	TAD I	NTEMP	/GET DEV.NUM
	AND	[17
	DCA	NT1	/INCHK NEEDS TO KNOW TOO
	TAD	NT1
	SNA		/IF 0,THEN NO DEVICE
	JMP	NEWDON
	DCA	NTEMP
	CLA CMA
	TAD I	(37	/GET PTR TO DEV TBL
	TAD	NTEMP
	DCA	NTEMP	/PTS TO ENTRY IN DEV TBL
	TAD I	NTEMP
	CDF	0
	SMA CLA
	JMP	FIX	/NOT A 2 PG HANDLER
	TAD	(6377	/FIX ALL LOCATIONS THAT REFER TO
/THE BUFFER VARIABLES.
/THE CHANGES ARE:
/OUBUF=6000,LINE=6400,INDEVH=6600,OUDEVH=7200
/INRECS=1,INCTL=200
	DCA I	(BLINE	
	TAD	(6000
	DCA I	(NOUBUF
	IFNZRO	RALF	<
	TAD	(5777
	DCA I	(MOUBUF	>	/FLAP DOESN'T USE ALL THE RALF LOCNS
	TAD	(6601
	DCA I	(NINDEV		
	TAD	(201
	DCA I	(NINCTL
	JMS	TPNSH	/TWO-PAGE NON-SYSTEM HANDLER
	DCA I	(NINREC
	TAD	(6000
	DCA I	(LOUBUF
	TAD	(7201
	DCA I	(NOUDEV
	TAD	(5777
	DCA I	(OUTPTR
	TAD	(6377
	DCA I	(CHRPTR
	IFNZRO	RALF	<
	TAD	(1401
	DCA I	(KOUBUF	>
	TAD	(7201
FIX,	DCA	NT2	/SET SO IF DID 2 PGS., DONT DO IT AGAIN
NEWDON,	ISZ	NEW	/GET CORRECT ADDR
	JMP I	NEW
NTEMP,	0
NT1,	0		/DEV. NUM.
NT2,	0		/0 IF NO 2PG HANDLERS YET
INCHK,	0		/CHECK THE INPUT DEVICES
	JMS	NEW
INLOC,	7617
	TAD	INLOC
	DCA	NEXTIN
ANOTH,	TAD	NT1
	SNA	CLA	/SKIP IF FILE USED
	JMP I	INCHK
	TAD	NT2
	SZA	CLA	/SKIP IF STILL 1 PAGE HANDLERS
	JMP I	INCHK
	TAD	NP2
	TAD	NEXTIN
	DCA	NEXTIN	/INCREMENT TO PT TO NEXT INPUT FILR
	JMS	NEW
NEXTIN,	0
	JMP	ANOTH
NP2,	2
NOKBIN,	CDF	10	/BELONGS WITH INIT CODE
	TAD I	[7600
	AND	NP17
	TAD	(7646
	DCA	WORD1		/CREATE POINTER INTO DEV TBL
	TAD I	WORD1
	CDF	0
	TAD	(-7607
	SNA	CLA		/IF ITS SYS, NO PROBLEMS
	DCA I	(RETSYS		/SO CAN ZERO CALL TO DELETE ROUTINE
	CDF	10
	TAD I	(7604
	SZA
	JMP	FEND		/AN EXT WAS SPECIFIED
	IFZERO	RALF	<
	TAD	(0216		/.BN DEFAULT FOR FLAP
	JMP	FEND	>
	IFNZRO	RALF	<
NOEXT,	CDF	10
	TAD I	(7643	/CHECK IF L OR G SPEC
	AND	L41
	SNA	CLA
	TAD	(0610		/NO-NEEDS RL EXT
	TAD	(1404	>	/YES-NEEDS LD
FEND,	DCA I	(7604
	CDF	0
	JMP I	(GBIN
L41,	41
TPNSH,	0
	TAD	(1401		/CHANGE OUTPUT BUFFER
	DCA I	(OUTBUF
	IAC
	JMP I	TPNSH
/
	PAGE
LDADR,	RELOC	OVBUFR
	TAD     ERRORS  /ERROR COUNT
        JMS I   (DECOUT
        JMS I   (PRTXT  /"ERRORS"
        TXERR-1
        -TXELN
        JMS I   [CRLF
	IFZERO	RALF	<
	TAD	PASSNO	/IF NOT LISTING PASS
	SPA SNA CLA	/ERROR COUNT IS ENUF
	JMP I	(RETSYS	>
        TAD     NEXT
        TAD     (-FREE+1 /DON'T COUNT BASIC SYMBOLS
        CLL RAR         /DIVIDE
        JMS I   (OVER3  /BY 6
        JMS I   (DECOUT
        JMS I   (PRTXT  /"SYMBOLS, "
        TXSYM-1
        -TXSLN
        IFZERO  RALF    <
        TAD     LINKS
        JMS I   (DECOUT
        JMS I   (PRTXT  /"LINKS"
        TXLNK-1
        -TXLLN          >
        IFNZRO  RALF    <
        TAD     ABREFS
        JMS I   (DECOUT
        JMS I   (PRTXT  /"ABS REFS"
        TXABR-1
        -TXALN          >
	JMS I	[CRLF
        TAD     (-33    /27 BUCKETS
        DCA     LTEMP
        DCA     BUCKET
        CLA CMA
        DCA     OPCODE  /SYMBOLS PER LINE COUNTER
STPRNT, TAD     BUCKET
        DCA     EXTMP   /BUCKET START ADDRESS
LUPBKT, CDF     FLD1
        TAD I   EXTMP   /WAS THAT LAST SYMBOL ?
        SNA
        JMP     NXTBKT  /YES, GO GET NEXT BUCKET
        DCA     EXTMP   /SAVE LINK ADDR
        TAD     EXTMP
        DCA     X14     /SET UP POINTER FOR NAME
        ISZ     OPCODE  /IS LINE FULL?
        JMP     .+4     /NO
        TAD     (-4
        DCA     OPCODE
        JMS I   [CRLF
        TAD     BUCKET
        SNA             /WATCH FOR #
        TAD     (43
        JMS I   [PRINT2 /PRINT BUCKET (FIRST) CHAR
        CDF     FLD1
        TAD I   X14     /SYMBOL
        JMS I   [PRINT2 /PRINT 2 AND 3
        CDF     FLD1
        TAD I   X14
        JMS I   [PRINT2 /PRINT 4 AND 5
        CDF     FLD1
        TAD I   X14
        IFNZRO  RALF    <
        DCA     OTEMP   /HOLD
        TAD     OTEMP   >
        AND     [7700   /PRINT 6 AND BLANK
        JMS I   [PRINT2
        IFNZRO  RALF    <
        TAD     OTEMP   /GET TYPE
        AND     [17
 	TAD     (TYPCOD /POINT TO TABLE
        DCA     OTEMP
        TAD I   OTEMP   /GET TYPE INDICATOR
        JMS I   [PRINT2 >
        CDF     FLD1
        TAD I   X14     /PRINT FIRST DIGIT
        AND     [7
        JMS I   (PDIG   /FIELD DIGIT
        CDF     FLD1
        TAD I   X14     /LOW 12 BITS
        JMS I   [OCTOUT
        JMS I   [PRINT2 /TWO BLANKS
        JMP     LUPBKT
NXTBKT,	ISZ	BUCKET	/NEXT BUCKET CHAR
	CDF	FLD0
	ISZ	LTEMP	/INCREMENT COUNT
	JMP	STPRNT
	JMS I	[CRLF	/DO FINAL CRLF**
	TAD	(214	/DO NOT PAGEJ
	JMS I	PC	/THAT WOULD GIVE A HEADING
	JMS I	(OCLOSE
	JMP I	(RETSYS	/FINISH IT OFF
	PAGE
	RELOC
/	PAGE 0 LITERALS
	FIELD	1
	*10000
/
/	SYMBOL TABLE IS IN FIELD ONE.
/	EACH ENTRY HAS THE FOLLOWING FORMAT
/
/	0: POINTER TO NEXT ENTRY IN BUCKET, 0 IF LAST
/	1: 2ND AND 3RD CHARS OF SYMBOL
/	2: 4TH AND 5TH
/	3: 6TH AND TYPE CODE
/	4: ESD # AND HIGH-ORDER VALUE
/	5: LOW-ORDER VALUE
/
	USER=1
	XTERN=2
	COMMN=3
	SECTN=4
	PSUDO=5
	PDPMR=6
	FPPMRF=7
	FPPSF1=10	/JXN, TRAP
	FPPSF2=11	/JA, SETB, SETX
	FPPSF3=12	/CLA, EXIT, NEG, NOP, NORM,
			/PAUS, JAC, STARTD, STARTF
	FPPSF4=13	/ALN, ATX, XTA
	FPPSF5=14	/ADDX, LDX
	FPPMRI=15	/%
	FPPMRS=16	/'
	FPPMRL=17	/#
	PDPOP=20
/
/	THE FOLLOWING CODE TRICKS THE LOADER INTO PUTTING
/	THE SYMBOL TABLE AT 2000, WHERE THE USR IS NOT,
/	THUS SAVING SOME SWAPPING AT LOAD AND INITIALIZE.
/	IT IS MOVED TO THE ASSEMBLED ADDRESS AFTER WE'RE
/	DONE WITH THE USR, AND BEFORE THE FIRST PASS BEGINS
/
	*12000
	NOPUNCH
	*10000
	ENPUNCH
/
/	BUCKETS FOR USER-DEFINED SYMBOLS
/	AND PDP8 OPERATES AND IOTS
/
	PNDL
	ZBLOCK 33
/
/	BUCKETS FOR INTERNALLY DEFINED SYMBOLS
/
	AL
	BL
	CL
	DL
	EL
	FL
	GL
	HL
	IL
	JL
	KL
	LL
	ML
	NL
	OL
	PL
	QL
	RL
	SL
	TL
	UL
	VL
	WL
	XL
	YL
	ZL
AL,	.+5		/ADDR
	0404;2200
	FPPSF2
	0
	.+5		/ADDX
	0404;3000
	FPPSF5
	0110
	.+5		/ALN
	1416;0
	FPPSF4
	0010
	IFZERO RALF <
	.+5		/AND
	1604;0
	PDPMR
	AND	0 >
	IFNZRO RALF	<
	.+5		/AND .
	1604;0
	PDPMR
	200
	.+5		/AND%
	1604;0
	PDPMR+500
	600
	.+5		/ANDZ
	1604;3200
	PDPMR
	0
	.+5		/ANDZ%
	1604;3200
	PDPMR+500
	400		>
	0		/ATX
	2430;0
	FPPSF4
	0020
BL,	0		/BASE
	0123;0500
	PSUDO
	BASEX
CL,	.+5		/CDF
	0406;0
	PDPOP
	CDF
	.+5		/CIA
	1101;0
	PDPOP
	CIA
	.+5		/CIF
	1106;0
	PDPOP
	CIF
	.+5		/CLA
	1401;0
	PDPOP
	CLA
	.+5		/CLL
	1414;0
	PDPOP
	CLL
	.+5		/CMA
	1501;0
	PDPOP
	CMA
	IFZERO RALF	< 0 >
	IFNZRO RALF	< .+5 >
	1514;0		/CML
	PDPOP
	CML
	IFNZRO	RALF	<
	.+5		/COMMON
	1715;1517
	PSUDO+1600
	COMMX
	0		/COMMZ (8-MODE COMM SECT)
	1715;1532
	PSUDO
	SECT8X-1	>
DL,	IFZERO	RALF	<
	.+5		/DCA
	0301;0
	PDPMR
	DCA	0	>
	IFNZRO RALF	<
	.+5		/DCA .
	0301;0
	PDPMR
	3200
	.+5		/DCA%
	0301;0
	PDPMR+500
	3600
	.+5		/DCAZ
	0301;3200
	PDPMR
	DCA	0
	.+5		/DCAZ%
	0301;3200
	PDPMR+500
	DCA I	0	>
	IFZERO RALF < 0 >	/DECIMAL
	IFNZRO RALF < .+5 >
	0503;1115
	PSUDO+0100
	DECX
	IFNZRO RALF < 0	/DPCHK
	2003;1013
	PSUDO
	DPCHKX	>
EL,	.+5		/E
	0;0
	PSUDO
	EX
	.+5		/END
	1604;0
	PSUDO
	ENDX
	IFZERO	RALF	<
	0		/ENPUNCH
	1620;2516
	PSUDO+0300
	ENPNCX	>
	IFNZRO	RALF	<
	.+5		/ENTRY
	1624;2231
	PSUDO
	ENTRX
	0		/EXTERN
	3024;0522
	PSUDO+1600
	EXTRNX	>
FL,	.+5		/F
	0;0
	PSUDO
	FX
	.+5		/FADD
	0104;0400
	FPPMRF
	1000
	.+5		/FADD#
	0104;0400
	FPPMRL+300
	1000
	.+5		/FADD%
	0104;0400
	FPPMRI+500
	1000
	.+5		/FADD'
	0104;0400
	FPPMRS+700
	1000
	.+5		/FADDM
	0104;0415
	FPPMRF
	5000
	.+5		/FADDM#
	0104;0415
	FPPMRL+300
	5000
	.+5		/FADDM%
	0104;0415
	FPPMRI+500
	5000
	.+5		/FADDM'
	0104;0415
	FPPMRS+700
	5000
	.+5		/FCLA
	0314;0100
	FPPSF3
	0002
	.+5		/FDIV
	0411;2600
	FPPMRF
	3000
	.+5		/FDIV#
	0411;2600
	FPPMRL+300
	3000
	.+5		/FDIV%
	0411;2600
	FPPMRI+500
	3000
	.+5		/FDIV'
	0411;2600
	FPPMRI+700
	3000
	.+5		/FEXIT
	0530;1124
	FPPSF3
	0
	IFNZRO RALF	<
	.+5		/FIELD1 (8-MODE FIELD1 SECT)
	1105;1404
	PSUDO+6100
	SECT8X-2	>
	.+5		/FLDA
	1404;0100
	FPPMRF
	0000
	.+5		/FLDA#
	1404;0100
	FPPMRL+300
	0000
	.+5		/FLDA%
	1404;0100
	FPPMRI+500
	0000
	.+5		/FLDA'
	1404;0100
	FPPMRS+700
	0000
	.+5		/FMUL
	1525;1400
	FPPMRF
	4000
	.+5		/FMUL#
	1525;1400
	FPPMRL+300
	4000
	.+5		/FMUL%
	1525;1400
	FPPMRI+500
	4000
	.+5		/FMUL'
	1525;1400
	FPPMRS+700
	4000
	.+5		/FMULM
	1525;1415
	FPPMRF
	7000
	.+5		/FMULM#
	1525;1415
	FPPMRL+300
	7000
	.+5		/FMULM%
	1525;1415
	FPPMRI+500
	7000
	.+5		/FMULM'
	1525;1415
	FPPMRS+700
	7000
	.+5		/FNEG
	1605;0700
	FPPSF3
	0003
	.+5		/FNOP
	1617;2000
	FPPSF3
	0040
	.+5		/FNORM
	1617;2215
	FPPSF3
	0004
	.+5		/FPAUSE
	2001;2523
	FPPSF3+0500
	0001
	.+5		/FPCOM
	2003;1715
	PDPOP
	6553
	.+5		/FPHLT
	2010;1424
	PDPOP
	6554
	.+5		/FPICL
	2011;0314
	PDPOP
	6552
	.+5		/FPINT
	2011;1624
	PDPOP
	6551
	.+5		/FPIST
	2011;2324
	PDPOP
	6557
	.+5		/FPRST
	2022;2324
	PDPOP
	6556
	.+5		/FPST
	2023;2400
	PDPOP
	6555
	.+5		/FSTA
	2324;0100
	FPPMRF
	6000
	.+5		/FSTA#
	2324;0100
	FPPMRL+300
	6000
	.+5		/FSTA%
	2324;0100
	FPPMRI+500
	6000
	.+5		/FSTA'
	2324;0100
	FPPMRS+700
	6000
	.+5		/FSUB
	2325;0200
	FPPMRF
	2000
	.+5		/FSUB#
	2325;0200
	FPPMRL+300
	2000
	.+5		/FSUB%
	2325;0200
	FPPMRI+500
	2000
	0		/FSUB'
	2325;0200
	FPPMRS+700
	2000
GL=	0		/AINT NONE
HL,	0		/HLT
	1424;0
	PDPOP
	HLT
IL,	.+5		/IAC
	0103;0
	PDPOP
	IAC
	.+5		/IFFLAP
	0606;1401
	PSUDO+2000
	IFZERO	RALF	<TRUE>
	IFNZRO	RALF	<FALSE>
	.+5		/IFNDEF
	0616;0405
	PSUDO+0600
	IFNDFX
	.+5		/IFNEG
	0616;0507
	PSUDO
	IFNEGX
	.+5		/IFNSW
	0616;2327
	PSUDO
	IFNSWX
	.+5		/IFNZRO
	0616;3222
	PSUDO+1700
	IFNZRX
	.+5		/IFPOS
	0620;1723
	PSUDO
	IFPOSX
	.+5		/IFRALF
	0622;0114
	PSUDO+0600
	IFNZRO	RALF	<TRUE>
	IFZERO	RALF	<FALSE>
	.+5		/IFREF
	0622;0506
	PSUDO
	IFREFX
	.+5		/IFSW
	0623;2700
	PSUDO
	IFSWX
	.+5		/IFZERO
	0632;0522
	PSUDO+1700
	IFZROX
	.+5
	1604;0530
	PSUDO
	INDXX
	.+5		/IOF
	1706;0
	PDPOP
	IOF
	.+5		/ION
	1716;0
	PDPOP
	ION
	IFZERO	RALF	<
	0		/ISZ
	2332;0
	PDPMR
	ISZ	0	>
	IFNZRO RALF	<
	.+5		/ISZ .
	2332;0
	PDPMR
	ISZ	.&7600	
	.+5		/ISZ%
	2332;0
	PDPMR+500
	ISZ I	.&7600
	.+5		/ISZZ
	2332;3200
	PDPMR
	ISZ	0
	0		/ISZZ%
	2332;3200
	PDPMR+500
	ISZ I	0	>
JL,	.+5		/JA
	0100;0
	FPPSF2
	1030
	.+5		/JAC
	0103;0
	FPPSF3
	0007
	.+5		/JAL
	0114;0
	FPPSF2
	1070
	.+5		/JEQ
	0521;0
	FPPSF2
	1000
	.+5		/JGE
	0705;0
	FPPSF2
	1010
	.+5		/JGT
	0724;0
	FPPSF2
	1060
	.+5		/JLE
	1405;0
	FPPSF2
	1020
	.+5		/JLT
	1424;0
	FPPSF2
	1050
	IFZERO	RALF	<
	.+5		/JMP
	1520;0
	PDPMR
	JMP	0
	.+5		/JMS
	1523;0
	PDPMR
	JMS	0	>
	IFNZRO RALF	<
	.+5		/JMP .
	1520;0
	PDPMR
	JMP	.&7600
	.+5		/JMP%
	1520;0
	PDPMR+500
	JMP I	.&7600
	.+5		/JMPZ
	1520;3200
	PDPMR
	JMP	0
	.+5		/JMPZ%
	1520;3200
	PDPMR+500
	JMP I	0
	.+5		/JMS .
	1523;0
	PDPMR
	JMS	.&7600
	.+5		/JMS%
	1523;0
	PDPMR+500
	JMS I	.&7600
	.+5		/JMSZ
	1523;3200
	PDPMR
	JMS	0
	.+5		/JMSZ%
	1523;3200
	PDPMR+500
	JMS I	0	>
	.+5		/JNE
	1605;0
	FPPSF2
	1040
	.+5		/JSA
	2301;0
	FPPSF2
	1120
	.+5		/JSR
	2322;0
	FPPSF2
	1130
	0		/JXN
	3016;0
	FPPSF1
	2000
KL,	.+5		/KCC
	0303;0
	PDPOP
	KCC
	.+5		/KRB
	2202;0
	PDPOP
	KRB
	.+5		/KRS
	2223;0
	PDPOP
	KRS
	0		/KSF
	2306;0
	PDPOP
	KSF
LL,	.+5		/LAS
	0123;0
	PDPOP
	LAS
	.+5		/LDX
	0430;0
	FPPSF5
	0100
	.+5		/LISTOFF
	1123;2417
	PSUDO+0600
	LSTOFX
	0		/LISTON
	1123;2417
	PSUDO+1600
	LSTONX
ML=	0		/NO LIST
NL,	IFZERO RALF	< .+5 >
	IFNZRO RALF	< 0 >
	1720;0		/NOP
	PDPOP
	NOP
	IFZERO	RALF	<
	0		/NOPUNCH
	1720;2516
	PSUDO+0300
	NOPNCX	>
OL,	.+5		/OCTAL
	0324;0114
	PSUDO
	OCTALX
	.+5		/ORG
	2207;0
	PSUDO
	ORGX
	0		/OSR
	2322;0
	PDPOP
	OSR
	IFZERO	RALF	<
PL,	0		/PAGE
	0107;0500
	PSUDO
	PAGEX	>
	IFNZRO	RALF	<PL=0	>
QL=	0		/WHAT DID YOU EXPECT?
RL,	.+5		/RAL
	0114;0
	PDPOP
	RAL
	.+5		/RAR
	0122;0
	PDPOP
	RAR
	.+5		/RDF
	0406;0
	PDPOP
	RDF
	.+5		/REPEAT
	0520;0501
	PSUDO+2400
	REPETX
	.+5		/RIB
	1102;0
	PDPOP
	RIB
	.+5		/RIF
	1106;0
	PDPOP
	RIF
	.+5		/RMF
	1506;0
	PDPOP
	RMF
	.+5		/RTL
	2414;0
	PDPOP
	RTL
	0		/RTR
	2422;0
	PDPOP
	RTR
SL,	.+5		/S
	0;0
	PSUDO
	SX
	IFNZRO	RALF	<
	.+5		/SECT
	0503;2400
	PSUDO
	SECTX
	.+5		/8 MODE SECT
	0503;2470
	PSUDO
	SECT8X >
	.+5		/SETB
	0524;0200
	FPPSF2
	1110
	.+5		/SETX
	0524;3000
	FPPSF2
	1100
	.+5		/SKP
	1320;0
	PDPOP
	SKP
	.+5		/SMA
	1501;0
	PDPOP
	SMA
	.+5		/SNA
	1601;0
	PDPOP
	SNA
	.+5		/SNL
	1614;0
	PDPOP
	SNL
	.+5		/SPA
	2001;0
	PDPOP
	SPA
	.+5		/STARTD
	2401;2224
	FPPSF3+0400
	0006
	.+5		/STARTE
	2401;2224
	FPPSF3+0500
	0050
	.+5		/STARTF
	2401;2224
	FPPSF3+0600
	0005
	.+5		/STL
	2414;0
	PDPOP
	STL
	.+5		/SZA
	3201;0
	PDPOP
	SZA
	0		/SZL
	3214;0
	PDPOP
	SZL
TL,	IFZERO	RALF	<
	.+5		/TAD
	0104;0
	PDPMR
	TAD	0	>
	IFNZRO RALF	<
	.+5		/TAD .
	0104;0
	PDPMR
	TAD	.&7600
	.+5		/TAD%
	0104;0
	PDPMR+500
	TAD I .&7600
	.+5		/TADZ
	0104;3200
	PDPMR
	TAD	0
	.+5		/TADZ%
	0104;3200
	PDPMR+500
	TAD I	0	>
	.+5		/TCF
	0306;0
	PDPOP
	TCF
	.+5		/TEXT
	0530;2400
	PSUDO
	TEXTX
	.+5		/TLS
	1423;0
	PDPOP
	TLS
	.+5		/TPC
	2003;0
	PDPOP
	TPC
	.+5		/TRAP3
	2201;2063
	FPPSF1
	3000
	.+5		/TRAP4
	2201;2064
	FPPSF1
	4000
	.+5		/TRAP5
	2201;2065
	FPPSF1
	5000
	.+5		/TRAP6
	2201;2066
	FPPSF1
	6000
	.+5		/TRAP7
	2201;2067
	FPPSF1
	7000
	0		/TSF
	2306;0
	PDPOP
	TSF
UL=	0
VL=	0
WL=	0
XL,	0		/XTA
	2401;0
	FPPSF4
	0030
YL=	0
ZL,	0		/ZBLOCK
	0214;1703
	PSUDO+1300
	ZBLKX
	IFZERO RALF	< PNDL=0 >
	IFNZRO	RALF	<
PNDL,	.+6		/BLANK COMMON
	0;0
	3		/CODE FOR COMMON
	40;0		/ESD #2, LEN=0
	0		/#MAIN
	1501;1116
	4		/CODE FOR SECTION
LMAIN,	20;0		/ESD #1, LEN=0>
FREE,
END,	END	/NICE WHEN FLAP ASSEMBLES
	$

