/ MULTI COMPILER   V 1.15
/
/ MULTI TERMINAL DIBOL COMPILER
/ BASED ON COS DIBOL COMPILER V01.11 BY SR
/
/COPYRIGHT 1972, 1973
/DIGITAL EQUIPMENT CORP.
/MAYNARD MASS.  01754
/
/THIS SOFTWARE IS FURNISHED TO PURCHASER UNDER A LICENSE FOR USE
/ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH INCLUSION
/OF DEC'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT
/AS MAY OTHERWISE BE PROVIDED IN WRITING BY DEC.
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT
/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
/EQUIPMENT CORPORATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
/OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
/

/ ASSEMBLY INSTRUCTIONS
/
/	.R PAL8
/	*MCOMP.BN,MCOMP.LS<MCOMP.PA/K
/
/ SAVE INSTRUCTIONS
/
/	.R ABSLDR
/	*ZEROES,MONITR
/	*MCOMP/R$
/	.SAVE DEV:MCOMP
/

	/DIBOL COMPILER
	/OPCODES
	/MEMORY ADDRESS CLASS
	FIXMRI CALL=	4400
	FIXMRI EXIT=	5400
	FIXTAB	
	PUSHOP=	1000
	PUSH1S=	2000
	PUSH2S=	3000
	BRASUB=	4000
	BRANCH=	5000
	BRATRP=	6000
	/OPERATE CLASS (0XXX)
	/MULTIPLY=	1
	/ADD=	2
	IMAGOP=	3
	/SUBTRACT=	4
	UMINUS=	5
	/DIVIDE=	6
	CLEARA=	11	/CLEARA MUST =	 CLEARD -1 !
	CLEARD=	12
	BCMPTD=	13
	RTRNOP=	14
	STOPOP=	15
	INITOP=	16
	XMITOP=	17
	READOP=	20
	WRITOP=	21
	FINIOP=	22
	FORMOP=	23
	STOROP=	24
	STORAA=	24
	STORAD=	25
	STORDA=	26
	STORDD=	27
	HERETR=	33	/TRACE
	HEREDC=	30	/HERE I IS
	SKPCND=	40	/SKIP ON CONDITION FALSE
	STADOP=	31	/ADD AND STORE
	STSBOP=	32	/SUBTRACT AND STORE
	CNVOCT=	7	/CNVERT OCTAL
	TRYOP=	34	/TRY LOGICAL UNIT #
	DISPOP=	35	/DISPLAY
	DISPUP=	36	/DISPLAY SPECIAL NUMERIC CODE
	ACPTOP=	37	/ACCEPT
	INCROP=	40
	CHNOP=	41
	ONERXX=	42
	HERENT=	43	/DONT TRACE

/
/	SPECIAL CODES FOR MULTI TERMINAL OPERATION
/
RELOP=	CHNOP		/RELEASE REPLACES CHAIN
LOKRC=	44		/LOCK RECORD
LOKOP=	45		/LOCK FILE
UNLREC=	46		/UNLOCK RECORD
UNLOK=	47		/UNLOCK FILE

LBUFR=	200	/BLOCK LITERAL BUFFER (LENGTH 100)
INPLIN=	300	/INPUT LINE BUFFER (LENGTH 100)
PDL=	4400	/PUSH DOWN LIST (LENGTH 100)
MBUFR=	4500	/LITERAL BUFFER (LENGTH 100)
CODBUF=	4600	/CODE BUFFER (LENGTH 200)
	READ=	0
	WRITE=	4000
	SRCBUF=	5000
	LEN0=	400	/512 WD BUFFERS
	LEN1=	400	/"
	OUTBUF=	6000
	MAGIC=	100
	LEN02=	2000	/2048 WD BUFFERS
	LEN12=	2000	/"
/LOADER CODES:
	KODE=	0		/PROGRAM CODE
	ACLEAR=	1	/ALPHA DATA CLEAR (OBSOLETE)
	DCLEAR=	2	/DECIMAL DATA CLEAR (MUST BE ACLEAR+1)
	SYMTAB=	3	/SYMBOL TABLE INDICATOR
	COMMAP=	4	/COMMA P
	PROCOD=	5	/PROC CODE
	DATAIN=	7	/DATA INITIALIZATION
	COMMAD=	10	/COMMA D
	DCLRCH=	11	/CLEARD IF NO CHAIN
	COMMAS=	12	/COMMA S
/ ADDED FOR MULTI-TERMINAL
	COMMAT=	13	/COMMA T
/1	ALPHA
/2	DECIMAL
/4	LABEL
/10	RECORD
/20	UNDEF?
/2000	FORWARD REFERENCE
/4000	CCP

	LPOCHR=	35
	TTOCHR=	31
	LENGTH=	44	/NEG OF MAX LENGTH
	OTOD=	74		/O TO D CONV
	KPUTC=	25
	KGETC=	24
	RDOIO=	26
	CDOIO=	27
	L7=	40
	L77=	20
	L7400=	2
	M1=	45
	W2=	50
	W3=	51
	L17=	64
	L70=	65
	M4=	66
	L7600=	70
	KCDF0=	71
	LISTSW=	7776	/CHAR "N" MEANS NO LIST
	SYSHND=	77
	TOPFLD=	7775
	SBT=	6370
	KPTRST=	43
	U0=	54
	W1=	47
	W4=	52
	W5=	53
	W0=	46
	GPBUF=	41
	REALSYS=	7774
	LPWDTH=	7773
	DOSW=	6260
	SYSDAT=	45
	MOVE=	23
	UTBASE=	6200	/SW
	CTRLO=	73
SFLD=	20			/SYMBOL TABLE MEMORY FIELD
VERSON=	20		/COMPILER VERSION NO. FOR RMSYS
BINEXT=	0415		/BINARY FILENAME EXTENSION "DM"
JOBSAV=	400		/OVERHEAD WORDS FOR JOB AREA

	*3
TM1,
NAME1,	0
TM2,
NAME2,	0
DATEM,
NAME3,	0
RCNT,
EXTMP1,	0
CRCNT,
EXTMP2,	0
	*11
XT,	0
X0,	-1
X1,	0
X2,	0
X3,	0
X4,	0
GOPTR,	7600-1
	*100
BYTX,
STREF,	0
PROGH,
OPRAND,	0
SYMNUM,	0
BYTORG,	JOBSAV^2		/DATA LOCATION COUNTER
SYMEND,	6		/END OF SYMBOL TABLE -1
PROGL,
LITNUM,	0		/DUMMY LITERAL NAME
NSYMS,	0		/NUMBER OF SYMBOLS
CHRPTR,	0
ENDKNT,
PDLCNT,	0
ELCNT,
LOCCTR,	0		/CODE LOCATION COUNTER
LOD,
TYPE,	0		/TYPE OF EXPRESSION
PFLAG,
TYPLFT,	0		/TYPE OF LEFT OF EQUAL SIGN
OLDBLK,	0		/ORIGIN OF LAST BLOCK
BLKOPT,	0		/OPTION C=0, X=1
OBSIZE,	2000		/PTR TO SIZE ENTRY OF BLOCK
LITSIZ,	0		/SIZE OF LITERAL (IN BYTES)
LINDIF,
CELSIZ,
EFL,
RIGHT,	0		/SET TO 1 IF RIGHT SIDE OF =
PROCNM,	0
R3,
COPT,	0		/NONZERO MEANS ,C OPTION IN EFFECT
LSTSW,	0		/0 MEANS LISTING
SIZ,
LINENO,	0
ORI,
OLDLNO,	0
ERKNT,	0		/# OF ERRORS
SIZE,	0		/TOTAL SIZE FOR CORG
BUNIT,	0		/BINARY OUTPUT UNIT
HIORG,	0		/HIGH ORDER DATA ORIGIN
HILOC,	0		/HIGH ORDER LOC COUNTER
BOUTLN,	402		/BINARY OUTPUT LENGTH
HIBOUT,	0		/HIGH ORDER PART
ELSIZE,	0
RECSIZ,	0		/ CURRENT RECORD SIZE
PDTEM,
BLNAME,	0		/0 IF UNNAMED BLOCK, 7000 IF NAMED BLOCK
SAVE,	0

/DUMB PSEUDO-PAGE ZERO LITERALS TO FAKE OUT PAL8
ZRESET,RESET
ZCDUMP,CDUMP
ZCODE,CODE
ZBACKUP,BACKUP
M100,
Z7700,7700
ZERROR,ERROR
ZLPAREN,LPAREN
NSKNT,
ZEXPR,EXPR
ZCOMA,COMA
ZNAME,NAME
ZRPAREN,RPAREN
ZNXTSTM,NXTSTM
ZPUSH,PUSH
ZPOP,POP
ZNXTCHR,NXTCHR
CORE,
ZM12,-12
ZLOOKUP,LOOKUP
ZM11,-11
LINKNT,	-1
ZM15,-15
ZPCRLF,	LPCRLF
ZNMLS,	NMLSER
ZM10,-10
ZPRINT,	PRINT
TSIZE,	0
ZSKIP,SKIP
NUMBER,	NOMBRE
NTEM,
Z3,3
Z10,10
Z101,	101
LP8PC,	7600		/ADDRESS OF "LPT" ROUTINE

	*200		/ONCE ONLY CODE
START,	TAD I	M4
	DCA	SYSHND
	JMS I	(SCRCHK		/CHECK BINARY SCRATCH AREA SIZE
SCROK,	CDF SFLD		/RETURN HERE IF OK
	IAC		/DUMMY ENTRY
	DCA I X0
	TAD Z101
	DCA I X0
	TAD Z101
	DCA I X0
	CLA IAC
	DCA I X0
	DCA I L7
	CDF 0
	TAD LPOCHR
	DCA LP8PC
	TAD I PLSTSW
	AND L77
	CALL (SWITCH
	CALL (DEIGHT
	STA
	TAD SYSHND	/GET SYSTEM HANDLER ADDR-1
	DCA START
	TAD I START	/LOOK AT CONTENTS
	TAD (-4565	/IS IT "DT"?
	SZA CLA
	DCA BUNIT	/USE UNIT 0 IF NOT DT
	STA
	DCA I (CODBUF
	TAD I (TOPFLD
	TAD	(-6221
	SPA		/NEED 12K OR MORE
	JMP I	(NOFGBG		/YOU LOSE
	SNA CLA
	JMP BUFSOK	/WORKING IN 12K
	TAD NEWSRB	/WORKING IN AT LEAST 16K
	DCA SRB		/ADJUST BUFFERS
	TAD SRB
	DCA I (SRB2
	DCA SRC		/USE ALL FIELD 3
	DCA I (SRC2	/0
	TAD GLUG2
	DCA GLUG
	TAD NEWSRC
	DCA OUTC
	STL CLA RAR	/4000
	DCA OUTB
	TAD (-1000
	CDF 10
	DCA I (STS
	CDF 00

BUFSOK,CLA STL RTL	/2
	CALL (SYSINI	/OPEN FILE 0 FOR INPUT
SRB,	READ+LEN0+SFLD
SRC,	SRCBUF		/BUFFER START
P7762,	7762		/UMONITOR ERROR
	TAD (MAGIC	/SET SPECIAL OUTPUT BLOCK
	DCA I (SBT	/AS FUDGE
	TAD (SBT
	DCA I (GET
	TAD OUTC
	TAD BUNIT
	DCA OUTC
	CLA IAC
	CALL (SYSINI	/OPEN FILE 1 FOR OUTPUT
OUTC,	WRITE+LEN1+SFLD
OUTB,	OUTBUF
PLSTSW,	LISTSW		/HALT IF ERROR
	TAD GLUG
	DCA I W3
	STA
	TAD OUTB
	DCA I W2
	TAD LSTSW
	SNA CLA
	JMP	NOFIX
	TAD	M4
	JMS I	MOVE
	CDF 10
	EMSG-1
	LSTNG-1
NOFIX,	CALL ZCDUMP
	PROCOD		/OUTPUT TYPE 5 RECORD
	STA		/-1, CHANGED AT END IF NO ERRORS
	CALL ZCODE	/PROC N
	CALL ZCODE	/PC FIELD
	CALL ZCODE	/PC START (ABOVE LITERALS)
	CALL ZCODE	/BINARY FILE LENGTH
	CALL ZCODE	/# SYMBOLS
	CALL ZCODE	/VERSION NUMBER FOR MULTI
	CALL ZCODE	/BINARY FILENAME EXTENSION FOR MONITOR
	CALL ZCODE	/PROGRAM SIZE (HIGH)
	CALL ZCODE	/PROGRAM SIZE (LOW)
	CALL ZCODE	/JOB AREA LENGTH (HIGH)
	CALL ZCODE	/JOB AREA LENGTH (LOW)
	CALL ZCODE	/LINE PRINTER USAGE (0=NO LPT INIT DONE)
	CALL ZRESET
	TAD I (LPWDTH
	DCA I (LPTWD
	JMP I	(NOWSTM

NEWSRB,	READ+LEN02+SFLD+10	/LOWER HALF FIELD 3 INPUT BUFFER
NEWSRC,	WRITE+LEN12+SFLD+10	/UPPER HALF FIELD 3 OUTPUT BUFFER
			/IF HAVE 16K OR MORE
GLUG,	-LEN1^2
GLUG2,	-LEN12^2
	PAGE

	*400
NAME,	0			/PICK UP VARIABLE NAME
	TAD Z101	/SET VAR NAME TO BLANKS
	DCA	NAME1
	TAD Z101
	DCA	NAME2
	TAD Z101
	DCA	NAME3
	JMS	NXTCHR
	JMP I	NAME
	JMS	LETTER		/MUST START WITH LETTER
	JMP	NONAME		/IF NOT A LETTER, BACKUP
	CALL ZBACKUP	/OTHERWISE BACKUP ANYWAY
	TAD	(NAME1+NAME1	/SET CHAR PTR FOR NAME
	DCA	NAMPTR
	CLL CMA RTL		/-3
	DCA	NAMCNT		/ONLY 3 WORDS SIGNIFICANT
	ISZ	NAME		/BUMP RETURN ADDR
IDLOOP,	JMS	NXTCHR		/GET NEXT NAME CHAR
	EXIT NAME	/IF END OF LINE, NAME DONE
	JMS	LETTER		/IS IT A LETTER?
	SKP			/NO
	JMP	.+3		/YES, SKIP SOME JUNK
	CALL	NUMBER		/IS IT A DIGIT?
	EXIT NAME	/NO, END OF NAME
	DCA	NAMCHR		/SAVE CHAR
	TAD	NAMPTR		/GET CHAR PTR
	CLL RAR			/SPLIT INTO WORD PTR,
	DCA	NAMTMP		/WHICH GETS STORED
	ISZ	NAMPTR
	TAD	NAMCHR
	SZL			/AND INDICATOR (IN LINK)
	JMP	LOWNAM		/IF LINK=0, LOWER CHAR
	RTL			/OTHERWISE UPPER
	RTL
	RTL
	IAC
	DCA I	NAMTMP		/SAVE UPPER CHAR
	JMP	IDLOOP		/AND GET SOME MORE

LOWNAM,	TAD I	NAMTMP		/COMBINE UPPER AND LOWER
	TAD M1
	DCA I	NAMTMP
	ISZ	NAMCNT		/BUMP COUNT
	JMP	IDLOOP
SKPNAM,	JMS	NXTCHR		/SKIP ANY
	JMP I	NAME		/NON-SIGNIFICANT
	JMS	LETTER		/CHARS
	SKP
	JMP	.+3
	CALL NUMBER
	EXIT NAME
	CLA
	JMP	SKPNAM
NAMPTR,	0
NAMCNT,	0
NAMTMP,
LETTER,	0			/SKIP ON LETTER
	TAD	(-40
	CLL
	TAD	(-34
	SNL
	ISZ	LETTER
	TAD	(74
	JMP I	LETTER

NAMCHR,	0
NONAME,	JMS I ZBACKUP		/REPLACE CHARACTER
	JMP I	NAME		/AND EXIT
GETCHR,	0	/GET NEXT CHAR
	TAD	CHRPTR
	DCA	CHP
	TAD (INPLIN
	JMS I	KGETC
CHP,	0
	SNA
	JMP I	GETCHR	/EOL
	TAD (-75
	SNA
	TAD (-74
	TAD L75
	ISZ	CHRPTR
	ISZ	GETCHR
	JMP I	GETCHR
SKIPT,	0
SKIP,	0
	TAD I	SKIP		/SKIP N CHARS
	DCA	SKIPT
	JMS I	ZNXTCHR
	NOP		/CAN OCCUR
	CLA
	ISZ	SKIPT
	JMP	.-4
	ISZ	SKIP
	JMP I	SKIP

NXTCHR,	0			/GET NEXT NON-BLANK CHAR
	JMS	GETCHR
	JMP I	NXTCHR
	TAD	M1		/BLANK IS 40 (OCTAL)
	SNA
	JMP	.-4
	TAD	(1-34		/TEST FOR ; (COMMENT)
	SNA
	JMP	SEMI
	TAD	(34
	ISZ	NXTCHR
	JMP I	NXTCHR
SEMI,	JMS I	ZBACKUP
	JMP I	NXTCHR
HEREAM,	0
	TAD (HEREDC
	CALL ZCODE
	TAD LINENO
	CALL ZCODE	/OUTPUT LINE #
	EXIT HEREAM
OPTMZ3,	0		/1 IF /O
FATAL,
L75,	75
	TAD I FATAL
	JMS I (ERMSG
	JMP I L7600
	PAGE

BACKUP,	0			/BACKUP 1 CHARACTER
	CLA CMA
	TAD	CHRPTR
	DCA	CHRPTR
	JMP I	BACKUP
CDUMP,	0			/CHANGE RECORD TYPE
	TAD I	(CODBUF
	CMA		/THIS ROUTINE COMPLETELY REWRITTEN BY RL
	SPA SNA CLA	/NULL RECORD?
	JMP ZRCODE	/YES - DON'T OUTPUT
	TAD ERKNT
	SZA CLA
	JMP NOCODE	/NO CODE IF ERRORS
	TAD I (CODBUF+1
	TAD I CDUMP
	SNA CLA
	JMP CDEXIT
	TAD I (CODBUF
	CIA
	IAC CLL
	TAD BOUTLN
	DCA BOUTLN
	SZL
	ISZ HIBOUT
	TAD HIBOUT
	TAD TOPF
	SMA CLA		/EXCEEDED BINARY AREA?
	JMP ER61	/YES!
	STL RAR
	DCA LENGTH	/NO LENGTH LIMIT
	CLA IAC
	CALL	RDOIO
	CODBUF-1
TOPF,	-2		/***
NOCODE,/CALL (OPRNT
ZRCODE,	STA
	DCA I	(CODBUF
	TAD	(CODBUF	/RE-INITIALIZE CODE BUFFER
	DCA	X3
	TAD I	CDUMP
	DCA I	X3	/INSERT RECORD TYPE
CDEXIT,	ISZ CDUMP
	JMP	I CDUMP

CODE,	0		/ROUTINE TO OUTPUT A WORD
	DCA I	X3	/STORE IT
	TAD I	(CODBUF+1/RL
	SNA CLA
	ISZ	LOCCTR	/BUMP PC IF RECORD TYPE IS "PROG"
	SKP
	ISZ HILOC
	STA
	TAD I	(CODBUF
	DCA I	(CODBUF	/BUMP COUNT
	TAD I	(CODBUF
	TAD	(177
	SNA CLA
	JMS CDUMP	/FORCE OUT CODE
	EXIT CODE	/NECESSARY ARGUMENT
	DCA I (CODBUF+1
	EXIT CODE
ER61,	CALL ZERROR	/BINARY OUTPUT TOO BIG
	ERR61

TYPSET,	CDF SFLD
	CLL STA RAR
	AND I EXTMP1
	AND (13
	SNA
	JMP	ER26
	CDF 0
	DCA	TYPE		/FIRST VARIABLE, SET TYPE
	JMP I	TYPCHK
TYPCHK,	0			/TYPE CHECK
	CDF SFLD
	CLL STA RAR
	AND I EXTMP1
	CDF 0
	SNA CLA
	JMP I	(UNDEF		/UNDEFINED
	TAD	TYPE
	SNA
	JMP	TYPSET		/FIRST OPERAND SO SET TYPE
	CDF SFLD
	AND I	EXTMP1		/COMPARE TYPES
	CDF 0
	SZA CLA
	JMP I	TYPCHK		/SAME, SO RETURN
IMGERR,
TYPERR,	CALL ZERROR	/MIXED MODE
	ERR6
ER26,	CALL	ZERROR
	ERR26		/NOT ALPHA OR DECIMAL

CORG,	0		/OUTPUT SIZE-ORIGIN
	TAD SIZE
	CLL RAL		/DEATH
	CLL RAL
	CLL RAL
	TAD HIORG
	JMS I ZCODE
	TAD BYTORG
	JMS I ZCODE	/LOW ORDER ORIG
	EXIT CORG	/RETURN
ER17,	CALL ZERROR	/SUBSCRIPT NOT DECIMAL
	ERR17
BLPAD,	0
	TAD Z101
	DCA I X2
	TAD Z101
	DCA I X2
	EXIT BLPAD
RESET,	0
	CLA
	TAD SAVE
	DCA CHRPTR
	TAD (PDL-1		/RESET STACK
	DCA X4
	TAD M100
	DCA PDLCNT
	CALL ZCDUMP
	KODE
	EXIT RESET
/RESET MIGHT BE ABLE TO GO IN-LINE
PROCSYM,0
ER47,	CALL ZERROR	/BAD ALPHA CONSTANT
	ERR47
	PAGE

EXPR,	0			/GET ARITHMETIC EXPR
	TAD EXPR
	CALL ZPUSH
	JMS I	ZPUSH		/MARK STACK
GTOPND,	JMS I	ZNXTCHR		/CHECK FOR UNARY MINUS
	JMP	MSNGOP		/NO CHARS MEANS ERROR
	TAD M4		/UNARY #?
	SZA
	JMP NONONA	/NO
	TAD TYPE
	CLL RTR		/MUST BE 0 OR 2
	SZA CLA
	JMP I (TYPERR
	DCA TYPE
	TAD (CNVOCT+12	/YES (KLUDGE)
	JMP PUSHON
NONONA,	CLL
	TAD ZM10	/UNARY +?
	SNA
	JMP UNARY	/LINK IS SET
	TAD	(-2
	SZA
	JMP	CKOPND		/NOT UNARY MINUS
	CLL		/LINK CLEAR IF -
UNARY,	TAD	RIGHT		/UNARY MINUS NO GOOD
	SNA CLA			/IF ON LEFT OF EQUALS
	JMP	BADLFT
	SZL
	JMP GTOPND	/IGNORE UNARY PLUS ON RIGHT
	TAD	(UMINUS+12	/PUT 56 FOR U.M.
PUSHON,	JMS I	ZPUSH
	JMP	GTOPND		/KEEP LOOKING FOR OPERAND
CKOPND,	TAD	(16-11		/CHECK FOR (
	SZA CLA
	JMP	NPAREN		/NOT PARENTHESIS
	JMS	EXPR		/COMPILE SUB EXPR
	CALL ZRPAREN
	JMP I	(GOPR8R		/IF FOUND, LOOK FOR OPERATOR

NPAREN,	JMS I	ZBACKUP		/PUT BACK CHAR
	JMS I	ZNAME		/LOOK FOR VARIABLE
	JMP I	(TRYLIT		/NOT VAR
	JMS I	ZLOOKUP		/DO S.T. LOOKUP
	CDF 0
	TAD	OPRAND		/SAVE POINTERS
	DCA	EXTMP1
	TAD	SYMNUM
	DCA	EXTMP2
	CALL (TYPCHK
	JMS I	ZNXTCHR		/CHECK FOR SUBSCRIPTS
	JMP	WASLIT		/IF NOTHING LEFT, FINISH THIS
	TAD	ZM11		/TEST FOR (
	SZA CLA
	JMP	NOSUBS		/NO ( MEANS NO SUBSCRIPTS
	TAD EXTMP2
	CALL ZPUSH
	JMS	RECEXP		/GET FIRST S.S.
	JMS I	ZNXTCHR		/GET DELIMITER
	JMP	SUBERR		/NOTHING IS SUBSCRPT ERR
	TAD	ZM12		/IS IT )
	SNA
	JMP	ONESUB		/YES, ONLY 1 S.S.
	TAD	(-3
	SZA CLA		/BETTER BE ,
	JMP	SUBERR	/NO
	JMS	RECEXP		/GET SECOND S.S.
	CALL (RPAREN
	CALL ZPOP
	TAD	(PUSH2S		/IS A.O.K. , GET PUSH 2 OP
	CALL ZCODE
	JMP I (GOPR8R

RECEXP,	0		/RECURSIVE EXPR
	TAD RECEXP	/MAKE RECEXP REC EXP
	CALL ZPUSH
	CLA IAC		/MAKE NON ZERO
	TAD TYPE
	CALL ZPUSH	/SAVE TYPE
	DCA TYPE	/LEAVE EXPR UNBIASED
	IAC
	TAD RIGHT
	CALL ZPUSH	/SAVE SIDE SWITCH
	IAC
	DCA RIGHT	/SUBSCRIPT EXPR ALLOWED ON LEFT
	JMS EXPR	/RECURSIVE CALL
	CALL ZPOP	/RESTORE SIDE SWITCH
	TAD M1
	DCA RIGHT
	CLL STA RAL	/-2
	TAD TYPE
	SZA CLA		/WHAT TYPE SUBSCR?
	JMP I (ER17	/NOT DECIMAL
	CALL ZPOP
	TAD M1
	DCA TYPE	/RESTORE TYPE
	CALL ZPOP
	DCA RECEXP	/RESTORE RET ADDR
	EXIT RECEXP	/RETURN

ONESUB,	CALL ZPOP
	TAD	(PUSH1S		/GET PUSH 1 OP
	CALL ZCODE
	JMP I (GOPR8R
NOSUBS,	JMS I	ZBACKUP		/PUT BACK NON (
WASLIT,	TAD	(PUSHOP		/GET PUSH OP
	TAD	EXTMP2		/ADD IN S.T. ADDR.
	JMS I	ZCODE		/OUTPUT IT
	JMP I	(GOPR8R		/NOW LOOK FOR OPERATOR
UNDEF,	CALL ZERROR	/UNDEFINED VARIABLE
	ERR5
BADLFT,	CALL ZERROR	/BAD LEFT SIDE
	ERR4
SUBERR,	CALL ZERROR	/SUBSCRIPT ERROR
	ERR3
MSNGOP,	CALL ZERROR	/MISSING OPERAND
	ERR2
	PAGE

SYSINI,	0
	JMS I KPTRST
	TAD I SYSINI
	DCA I W0
	ISZ SYSINI
	TAD I	W0
LL40,	AND	L7
	TAD I SYSINI
	ISZ SYSINI
	DCA I W1
	TAD I GET
	SNA
	JMP I SYSINI
	ISZ GET
	CLL RTR
	RTR
	DCA TEMP
	TAD TEMP
	RAR
	AND L7400
	DCA I W5
	TAD TEMP
	AND (377
	DCA I W4
	DCA I W3
	ISZ SYSINI
	JMP I SYSINI
GET,	SBT

CDOIOC,	0
	IAC		/FOR COMPATIBILITY
	DCA PRCADR
	DCA SUPLCT
	TAD (-16
	DCA PTABCT
	TAD LPTWD
	DCA PRWDTH
	DCA WRELC
PRLOOP,	TAD PRCADR
	SPA
	CDF 10
	CALL KGETC
TEMP,
WRELC,	0
	SNA
	JMP PRCRLF
	JMS LPTCHR
	ISZ WRELC
	JMP PRLOOP
LPTWD,	0
ROUND,	0
	ISZ BYTORG
	SKP
	ISZ HIORG
	CLL STA RAL	/ROUND TO EVEN BYTE
	AND BYTORG
	DCA BYTORG
	STL RTL
	AND HIORG
	SNA CLA
	EXIT ROUND
	JMS I ZERROR
	ERR63		/TOO MUCH DAMN DATA

LPTCHR,	0
	TAD (-75
	SNA
	JMP PRTTAB
	TAD (334
	JMS BUMPTC
	EXIT LPTCHR
PRTTAB,	TAD LL40
	JMS BUMPTC
	JMP PRTTAB
PRCRLF,	JMS LPCRLF
	JMP I CDOIOC
LPCRLF,	0
	TAD (215
	CALL LP8PC
	TAD (212
	CALL LP8PC
	EXIT LPCRLF
BUMPTC,	0
	CALL LP8PC
	ISZ PRWDTH
	JMP .+3
	ISZ SUPLCT
	JMS LPCRLF
	ISZ PTABCT
	EXIT BUMPTC
	TAD ZM10
	DCA PTABCT
	EXIT LPTCHR
PRWDTH,	0
PTABCT,	0
SUPLCT,	0

PRCADR,
SFINI,	0
	CALL KPTRST
	TAD I W2
	DCA XT
	TAD I W0
	AND L70
	TAD KCDF0
	DCA .+1
	HLT
	DCA I XT
	CDF 0
	CALL GPBUF
	DCA I W0
	EXIT SFINI
LL20,	20
EER12,	CALL ZBACKUP
ER12,	CDF SFLD
	TAD (6000
	AND I OPRAND
	TAD LL20
	DCA I OPRAND	/INSERT REDEF TYPE
	CALL ZERROR
	ERR12		/NAME PREVIOUSLY DEFINED
HILIT,	0004		/BEGINNING OF SHARABLE LITERALS
LITORG,	0		/HIDE HERE AWAY FROM END OVERLAY
	PAGE

LOOKUP,	0	/LINK TO FIELD 1
	CIF 10
	JMS I (XLOOK
	JMP I LOOKUP	/RETURN HERE WITH CDF SFLD
	CALL (FATAL	/HERE ON SYMBOL TABLE OVERFLOW
	ERR23
LROUND,	0
	ISZ I (LITORG
	SKP
	ISZ I (HILIT
	CLL STA RAL
	AND I (LITORG
	DCA I (LITORG
	JMP I LROUND
RELEAS,	TAD (-4264
	TAD NAME3
	SZA CLA
	JMP I ZNMLS	/ANOTHER WIERDY
	TAD (RELOP
	JMS I ZCODE
	CALL ZSKIP
	-3
	JMP I ZNXTSTM
PROC,	TAD	(-5
	CDF 10
	JMS I	MOVE	/CHANGE THE SUBHEADER
	CDF 10		/TO READ "PROCEDURE DIVISION"
	PRCDIV-1	/INSTEAD OF "DATA DIVISION"
	SUBHDG+2	/LEAVING THE USERS COMMENTS (IF ANY) UNDISTURBED
	DCA LOCCTR
	CALL (HEREAM
	TAD L7		/DEFAULT IS 7
	DCA PROCNM
	CALL (ROUND
	JMP I (PRCSWP
PUSH,	0
	DCA I	X4
	ISZ	PDLCNT
	JMP I	PUSH
	JMS I	ZERROR
	ERR22

	ISZ CHRPTR
NMLSER,	CALL ZERROR
	ERR11
WRNGFP,	0
	CDF 00
	TAD I (HILIT
	CDF SFLD
	DCA I OPRAND
	CDF 00
	ISZ OPRAND
	JMP I WRNGFP
POP,	0
	TAD	X4
	DCA	WRNGFP
	CMA
	TAD	X4
	DCA	X4
	CMA
	TAD	PDLCNT
	DCA	PDLCNT
	TAD I	WRNGFP
	JMP I	POP
	PAGE

CPUTC,	0
	CALL KPUTC
LMBUFR,	MBUFR-1
LCNUM,	0
	ISZ LCNUM
	JMP I CPUTC

LITERL,	0			/LOOK FOR A LITERAL (LATERALLY!)
	DCA LCNUM
	DCA	ALIT		/SET TYPE TO DECIMAL
	JMS I	ZNXTCHR		/GRAB A CHARACTER
	JMP I	LITERL		/SORRY, NONE LEFT
	JMS I	NUMBER		/IS IT A DIGIT?
	JMP	QUOTCK		/NO, TRY A QUOTE
	JMS I	ZBACKUP		/YES, BACK 1
STLIT,	DCA	LITSIZ		/LITERAL HAS 0 LENGTH
LITLUP,	JMS	GLCHR		/GET NEXT CHAR (LITERALLY)
	JMP	ENDLIT		/END IT OFF
	JMS CPUTC
	ISZ	LITSIZ		/BUMP SIGHS AGAIN
	JMP	LITLUP		/AND LOOP
ENDLIT,	ISZ LITERL	/BUMP RETURN ADDRESS
	JMS CPUTC
	JMS CPUTC
	JMS CPUTC
	TAD I (MBUFR
	DCA NAME2
	TAD I (MBUFR+1
	DCA NAME3
	ISZ LITNM	/UNIQUE BY 2
	ISZ LITNM
	TAD (-5
	TAD LITSIZ
	SMA CLA
	TAD LITNM	/UNIQUE NAME IF .GT. 4 DIGS
	TAD ALIT	/WORK IN TYPE
	TAD Z10
	DCA NAME1
	TAD I (PROCSYM
	CALL ZLOOKUP
	CLL STA RAR
	AND I OPRAND
	CDF 0
	SZA CLA		/PREV DEF?
	JMP I LITERL	/YES, RETURN
	CALL (ORDAIN

	TAD ALIT	/SET TYPE
	CMA		/0 BECOMES 2 DECIMAL
	TAD Z3		/-6 BECOMES 10 RECORD (1 STAYS)
	CDF SFLD
	TAD I OPRAND
	DCA I	OPRAND		/PUT TYPE INTO S.T.
	ISZ OPRAND
	IAC
	DCA I	OPRAND		/DIMENSION IS 1
	ISZ OPRAND
	TAD	LITSIZ
	CLL RAL
	RTL
	CALL (WRNGFP
	TAD I (LITORG
	CDF SFLD
	DCA I OPRAND
	CDF 00
	TAD I (LITORG
	TAD LITSIZ
	DCA I (LITORG
	CLL STA RTL	/-3
	TAD OPRAND
	DCA OPRAND	/OPERAND PTS. TO TYPE
	TAD ALIT
	SPA CLA
	CALL (LROUND
	JMP I	LITERL		/NOW EXIT

QUOTCK,	CALL ZNXTCHR
LITNM,	4	/CANNOT OCCUR
	TAD	ZM10		/IS IT A '
	ISZ	ALIT		/DON'T KNOW, BUT SET IT ANYWAY
	SNA
	JMP	STLIT		/YUP, IT WAS
	TAD (5
	SNA CLA		/IS IT "?
	JMP RECLIT	/YES
	JMS I	ZBACKUP		/NOPE, PUT CHAR BACK
	JMP I	LITERL		/AND RETURN WITH NO SKIP
GLCHR,	0			/PICK UP A CHAR FOR LIT
	TAD	ALIT		/IS IT ALPHA OR DEC?
	SZA CLA
	JMP	GETACH		/ITS ALPHA
	JMS I	ZNXTCHR		/GET A CHAR
	JMP I	GLCHR		/NO MORE, FINISH IT OFF
	JMS I	NUMBER		/DIGIT?
	EXIT GLCHR	/NO
GLRET,	ISZ	GLCHR		/YES, BUMP RETURN
	JMP I	GLCHR		/RETURN

GETACH,	JMS I	(GETCHR		/NEXT CHAR (BLANKS INCL.)
	JMP	BADLIT		/MISSING QUOTE
	TAD	ZM10		/IS IT A '
	SNA
	JMP I	GLCHR		/YES, LIT. DONE
	TAD Z10
	JMP GLRET
BADLIT,	JMS I	ZERROR
	ERR10			/MISSING QUOTE ERROR
ALIT,	0		/0:DECIMAL, 1:ALPHA, -6:RECORD
RECLIT,	CALL (LROUND
	TAD (-6
	DCA ALIT
	TAD Z10
	JMS CPUTC
	TAD Z10
	JMS CPUTC
	STL CLA RTL
	JMP STLIT
	PAGE

PROCST,	DCA I (IFLG
	JMS I	ZNAME		/LOOK FOR A SYMBOL
	JMP	I (NMLSER-1	/THIS IS A NAMELESS ERROR
	JMS I	ZNXTCHR		/IS THIS A LABEL?
P5,	5			/MUST BE ONE WORD COMMAND
	TAD	ZM15		/TEST FOR ,
	SZA CLA
	JMP	NOLABL
	TAD I (PROCSYM
	JMS I	ZLOOKUP		/DO S.T. LOOKUP
	TAD I	OPRAND		/SHOULD NOT BE PREVIOUSLY DEF
	CLL RAL
	SMA SZA CLA
	JMP I (EER12
	TAD Z10
	RAR
	DCA I	OPRAND		/SET TYPE TO
	ISZ	OPRAND		/"DEFINED LABEL"
	ISZ	OPRAND
	TAD HILOC
	TAD Z10
	DCA I OPRAND
	ISZ	OPRAND
	TAD	LOCCTR		/STORE LABEL VALUE
	DCA I	OPRAND
	CDF 0
	TAD CHRPTR
	DCA SAVE
OPTMZ1,	CALL (HEREAM	/OUTPUT LINE# (CLA IF /O)
	JMP EQL
NOLABL,	TAD SAVE
	DCA CHRPTR
	TAD LINENO
	CIA
	TAD OLDLNO	/FORM DIFFERENCE
	DCA LINDIF
	STL CLA RTR
	RAR		/CLL AND TAD (1000
	TAD LINDIF
	SNL CLA		/IS IT LESS THAN 1000?
	JMP OPTMZ1	/NO, GUY'S CRAZY
	TAD LINDIF
OPTMZ2,	CALL ZCODE	/OUTPUT DIFFERENCE (CLA IF /O)

EQL,	DCA	RIGHT	/ZERO QUOTE COUNTER
	ISZ	ONERCT	/IF THIS IS THE 2D STATEMENT
	JMP	.+3	/AFTER AN "ON ERROR" STATEMENT
	TAD	(ONERXX	/OUTPUT A SPECIAL CODE
	CALL	ZCODE	/TO CANCEL THE ERROR TRAP
EQLOOP,	JMS I	ZNXTCHR
	JMP I	(COMAND	/NO EQUAL SIGN - MUST BE A COMMAND
	TAD	ZM10
	SNA
	ISZ	RIGHT	/BUMP QUOTE COUNTER ON QUOTES
	TAD P5
	SZA
	JMP .+3
	CLA IAC
	DCA RIGHT
	TAD (3-36
	SZA CLA
	JMP	EQLOOP	/NO = YET, KEEP LOOKING
	CLA IAC
	AND	RIGHT
	SZA CLA		/ARE WE IN QUOTES?
	JMP	EQLOOP	/YES - DOESNT COUNT
	TAD SAVE
	DCA CHRPTR
	DCA	RIGHT		/SET SWITCH FOR LEFT SIDE
	DCA	TYPE		/ZERO TYPE
	JMS I	ZEXPR		/ASSUME ARITHMETIC UNTIL PROVEN
	JMS I	(CKLET
	36			/CHECK FOR "="
	JMS I	ZNXTCHR		/IF END OF STATEMENT
	JMP I	(CLEAR		/IT WAS A "CLEAR"
	JMS I	ZBACKUP		/PUT BACK CHAR
	TAD	TYPE
	DCA	TYPLFT		/SAVE TYPE OF LEFT SIDE
	DCA	TYPE		/RE-ZERO TYPE
	ISZ	RIGHT		/SET SWITCH FOR RIGHT SIDE
	JMS I	ZEXPR		/GET RIGHT SIDE OF EXPR
	TAD TYPLFT
	TAD TYPE
	AND Z10
	SZA CLA
	JMP I (IMGERR
	JMS I	ZNXTCHR
	SKP
	JMP I	(IMAGE		/CHECK FOR DECIMAL,ALPHA
	TAD TYPLFT
	AND	Z10	/********THINK SHOULD BE Z10 (USED TO BE ZM10)
	SZA CLA		/IS LEFT SIDE A BLOCK?
	JMP	AASTOR	/YES - USE ALPHA STORE
	STA CLL RTL	/-3
	TAD TYPLFT
	CLL RAL
	TAD TYPE	/COMBINE LEFT AND RIGHT TYPES
	SZA
	JMP FASTZ	/MIXED MODES - DON'T OPTOMIZE
	TAD X3		/DO OPTIMIZATION ON A=B+C AND A=B-C
	DCA TYPE		/BUT ONLY IF D TO D STORE
	CLL STA RAL	/-2
	TAD I TYPE	/GET LAST CODE ENTRY
	CLL RTR		/DON'T GO THROUGH 'CODE'
	SZA CLA		/2 OR 4?
	JMP FASTZ	/NO
	RAL		/YES, LINK ON MEANS 4 (SUB)
	TAD (STADOP
	DCA I TYPE	/INSERT
	JMP I ZNXTSTM
AASTOR,	STA CLL RTL	/STORAA=STORDD-3
FASTZ,	TAD (STORDD
	JMS I	ZCODE
	JMP I	ZNXTSTM		/GO DO NEXT STMT
ONERCT,	0
	PAGE

STAR,	JMS I	(CKLET
	65		/CHECK FOR "START"
COMM,	JMS COM
	STA
	DCA LINKNT
	JMP NEWSTM
COM,	0
EOP,	CALL ZNXTCHR	/LOOK FOR SLASH
	JMP EOL		/END OF LINE
	TAD (-20
	SNA CLA		/IS IT SLASH?
	CALL ZNXTCHR	/YES
	NOP		/MISSING ARG
	TAD (-65
	SNA		/IS IT /T?
	JMP ITST	/YES
	TAD Z10
	CLL RTR
	SZA
	JMP ER14		/NOT L OR N
	SNL
	JMP ITSL
	ISZ LSTSW	/N
	JMP EOP
ITSL,	TAD I (LPWDTH
	DCA I (LPTWD
	TAD LPOCHR	/L
	JMP ITSLT
ITST,	TAD (-110
	DCA I (LPTWD
	TAD TTOCHR	/T
ITSLT,	DCA LP8PC
	STL CLA RAR
	AND LSTSW
	DCA LSTSW
	JMP EOP
EOL,	TAD	L32
	DCA	PUTCN	/INITIALIZE CHAR POINTER INTO SUBHEADER
	ISZ CHRPTR
STARLP,	TAD	PUTCN
	TAD	(-115
	SNA CLA		/ARE WE AT THE END OF THE SUBHEADER?
	EXIT COM	/YES - IGNORE EXCESS CHARS & PROCEED
	JMS I	(GETCHR	/GET A CHAR
L32,	32		/CR - BIG DEAL
	CDF 10
	JMS I	KPUTC
	SUBHDG		/PUT THE CHAR INTO THE SUBHEADING
PUTCN,	0
	ISZ	PUTCN	/BUMP POINTER
	JMP	STARLP	/LOOP

NXTSTM,	JMS I	ZNXTCHR
	JMP	.+3
ER14,	JMS I	ZERROR
	ERR14
	CALL ZRESET	/FORCE OUT LAST RECORD
NEWSTM,	TAD LSTSW
	SNA CLA		/PRINT LAST LINE
	CALL ZPRINT	/YES
	INPLIN-1	/NO
NOWSTM,	JMS I	(GETLIN		/GET NEXT LINE
	TAD CHRPTR
	DCA SAVE
	CALL ZNXTCHR	/NULL LINE?
	JMP	RSETLN	/RESET LINE # AND GET NEXT STMT
	TAD (-40	/(USE SMA SZA CLA)***
	CLL
	TAD Z3
	JMS I (CCP
	CALL ZRESET
	JMP I BLKJMX
RSETLN,	CDF 0
	TAD	OLDLNO
	DCA	LINENO	/RESTORE LINE NUMBER
	JMP	NEWSTM

BLKJMX,	BLOCK
PRCSWP,	CDF 10
	TAD (PRCOVF-PRCOVL
	CALL MOVE
	CDF 00
	PRCOVO-1	/ORIGIN IN FIELD 1
	PRCOVF-1	/PROPOSED ORIGIN IN FIELD 0
	TAD NSYMS
	IAC		/COMPUTE FIRST NON-DATA SYMBOL #
	DCA I	(PROCSYM	/STORE FIRST NON-DATA SYMBOL #
	CLA STL RTR	/*** KLUDGE ***
	DCA	BLKJMX	/*** STORE "PROCST" IN "BLKJMX" ***
	TAD NAME3
	AND Z7700
	CLL RTR
	RTR
	RTR		/GET DIGIT
	TAD M1
	SNA
	JMP	COMM	/BLANK DEFAULTS TO 7
	TAD	(-20	/BUT 0 REMAINS 0
	DCA PROCNM	/SAVE IT
	TAD PROCNM
	AND ZM10	/IS IT 0-7?
	SNA CLA
	JMP	COMM
	CALL ZERROR	/BAD PROC #
	ERR70
	PAGE

TRYST,	TAD NAME1	/LOOK FOR START
	TAD (-6465	/"ST"
	SNA CLA
	TAD NAME2
	TAD (-4263	/"AR"
	SNA CLA
	TAD NAME3
	TAD (-6501	/"T"
	SZA CLA
	JMP I ZNMLS
	JMP I (COMM	/UGGH
TRYREC,	TAD NAME1	/LOOK FOR "RECORD"
	TAD (-6346	/"RE"
	SNA CLA
	TAD NAME2
	TAD (-4460	/"CO"
	SNA CLA
	TAD NAME3
	TAD (-6345	/"RD"
	SZA CLA
	JMP TRYPRC
	JMS I ZRESET
	CALL ZSKIP
	-6		/PASS OVER RECORD CHARS
	JMP I (RECORD	/JOIN PROCESSING

ORDAIN,	0
EXT,	CALL ZCDUMP
	DATAIN
	TAD LITSIZ
	CLL RTL
	RAL
	TAD I (HILIT
	CALL ZCODE	/OUTPUT SIZE
	TAD I (LITORG
	CALL ZCODE	/AND ORIGIN
	TAD (MBUFR-1
	DCA X2
	STA
	TAD LITSIZ
	CLL CML CMA RAR
	DCA LTMP
	TAD I X2
	CALL ZCODE
	ISZ LTMP
	JMP .-3
	CALL ZCDUMP
	KODE
	TAD I (HILIT	/TEST FOR MORE THAN 8K LITERALS
	AND L7
	TAD	(-6
	SPA SNA CLA
	EXIT ORDAIN
	CALL ZERROR	/HOW COULD ANYONE NEED 12K LITERALS?
	ERR100
LTMP,	0

NOMBRE,	0		/SKIP ON DIGIT
/	BACKUP SCAN IF NOT FOUND
	TAD (-33
	CLL
	TAD (12
	SNL
	JMP NONONO
	ISZ NOMBRE
	TAD (21
	EXIT NOMBRE
NONONO,	CLA
	CALL ZBACKUP
	EXIT NOMBRE
COMA,	0		/SKIP ON COMMA
	CALL ZNXTCHR	/GET NEXT CHAR
	JMP ER56	/EOL IS BAD
	TAD ZM15	/IS IT ","?
	SNA CLA
	EXIT COMA	/RETURN
ER56,	CALL ZERROR	/MISSING COMMA
	ERR56

TRYPRC,	CALL ZNXTCHR
	JMP NOCO
	TAD ZM15
	SNA CLA		/IS IT ","?
	JMP I (DATASP	/YES
	CALL ZBACKUP	/NO KEYWORDS!
NOCO,	TAD	NAME1		/LOOK FOR "PROC"
	TAD	(-6163		/"PR"
	SZA	CLA
	JMP TRYST	/MAYBE ITS AN ANACHRONISM
	TAD	NAME2
	TAD	(-6044		/"OC"
	SZA	CLA
	JMP TRYST
	TAD	NAME3
	AND L77
	TAD M1
	SZA	CLA
	JMP TRYST
	CALL (FIX
	JMP I (PROC
IFTST,	TAD I	(IFLG
	SNA CLA			/FIX A BUG THAT'S BEEN AROUND SINCE YEAR 1
	JMP I	ZNXTSTM
	JMP I	(MSNGOP
	PAGE

	ERTMP=EXTMP1
ERMSG,	0		/PRINT ERROR MESSAGE
	TAD	M1
	DCA ADRER	/ADDR OF TEXT IS IN AC
	DCA I (DOSW
	TAD ERKNT
	SZA CLA
	JMP MORERR
	IAC		/TAD (IFN1
	CALL (SFINI
MORERR,	ISZ ERKNT
	CALL ZPRINT	/NO, PRINT NOW
	INPLIN-1
	TAD CHRPTR
	TAD	(-6
	CMA
	DCA CHRPTR	/USE CHRPTR AS KNT
	DCA I (SUPLCT
	TAD (-16
	DCA I (PTABCT
	DCA I (PRWDTH
	TAD	M4
	DCA	INK
	TAD (16
	CALL (LPTCHR	/OUTPUT 4 UNDERLINES TO LPT
	ISZ	INK
	JMP	.-3
	TAD (4
	DCA INK

BLINS,	TAD (INPLIN
	CALL KGETC
INK,	4
	TAD (-75
	SNA CLA		/OUTPUT TABS AS TABS
	TAD L74		/AND OTHER CRAP AS SPACES
	IAC
	CALL (LPTCHR
	ISZ INK		/GO TO NEXT CHAR
	ISZ CHRPTR	/THROUGH?
	JMP BLINS
	TAD L77
	CALL (LPTCHR	/INSERT CARET
	CALL (LPCRLF	/CRLF
	TAD (-6
	DCA ERTMP	/PAD WITH 6 SPACES
	TAD (240
	CALL LP8PC
	ISZ ERTMP
	JMP .-3
	IAC		/INHIBIT LPT LINE COUNT
	CALL ZPRINT
ADRER,	0
	TAD (212
	CALL LP8PC	/LF
	TAD LINKNT
	TAD Z3
	DCA LINKNT
	TAD LINKNT
	SMA
	STA
	DCA LINKNT
	EXIT ERMSG

NOEND,	CLA STL RTL	/TRY TO OPEN NEXT SOURCE FILE
			/IFN0=2
	CALL (SYSINI
SRB2,	READ+LEN0+10	/FOR INPUT
SRC2,	SRCBUF		/START OF BUFFER
	JMP EENDYD	/NO MORE
	STA
	DCA LINKNT
	JMP I (NOWSTM
EENDY,	TAD LSTSW
	SNA CLA		/PRINT END STATEMENT?
	CALL ZPRINT	/YES
	INPLIN-1	/NO
	TAD SAVE	/RESET
	DCA CHRPTR
	CALL ZSKIP
	-3
	CALL (COM
EENDYD,	CALL (LROUND
	TAD (ENDOVF-ENDOVL
	CDF 10
	CALL MOVE
	CDF 00
	ENDOVO-1	/ACTUAL LOCATION
	ENDOVF-1	/NEW FIELD 0 LOCATION
	TAD (STOPOP
	CALL ZCODE
	CALL ZCDUMP
L74,	74		/NEED TO DUMP END OF CODE
	JMP I (ENDST	/GO TO IT
ERROR,	0
	CLA
	CDF 0
	TAD I ERROR
	JMS ERMSG
	JMP I ERET
ERET,	NOWSTM
	PAGE

IF,	TAD SAVE
	DCA CHRPTR
	CALL ZSKIP
	-2
	CALL ZLPAREN
	DCA	TYPE		/ZERO TYPE
	IAC
	DCA	RIGHT		/SET RIGHT-SIDE SWITCH
	JMS I	ZEXPR		/NOW GET FIRST EXPR
	JMS I	ZNXTCHR		/LOOK FOR .
	JMP	ER65
	TAD	(-17
	SZA CLA
	JMP ER65
	JMS I	ZNAME		/GET RELATIONAL
	JMP	ER65
	TAD	NAME2
	AND L7600
	SZA CLA
	JMP I (ER25
	TAD	(-6		/LOOK UP RELATIONAL
	DCA I	(IFCCOD
	TAD	(RELLST-1
	DCA	X0
RLOOP,	CDF 10		/MOVED THE LIST UP
	TAD I	X0		/IN THIS LOOP
	CDF 00
	TAD	NAME1
	SNA CLA
	JMP I	(GOTREL
	ISZ I	(IFCCOD	/BUMP CONDITION CODE
	JMP	RLOOP
ER65,	CALL ZERROR	/MISSING RELATIONAL
	ERR65

/0	<
/1	=
/2	>
/RETURN TO RSETLN TO IGNORE LINE
/IF LINK IS ON, IT'S A CCP COMMAND
/NORMAL RETURN TO PROCESS LINE
CCP,	0
	SNL		/IS IT A CCP COMMAND?
	JMP REGCOM	/NO
	TAD JT
	DCA .+1
IGNORE,	0
	TAD NOCOMP
	SZA CLA
	JMP BLNKLN
	CALL ZNAME	/LOOK FOR VARIABLE
	JMP ER71	/NAME MISSING
	CALL ZLOOKUP
	TAD I OPRAND
	JMP I IGNORE
JT,	JMP I .+1
	CCLT
	CCEQ
	CCGT
CCLT,	ISZ LTKNT	/BUMP LT COUNT
	JMS IGNORE
	SMA CLA		/IS IT DEFINED?
	ISZ NOCOMP	/YES
	TAD LTKNT
	CIA
	DCA OFFKNT	/SAVE (NEG OF) LTKNT
	JMP I (RSETLN	/IGNORE LINE
CCEQ,	JMS IGNORE
	TAD (4000
CCOM,	DCA I OPRAND	/DEFINE IT
	JMP I (RSETLN

CCGT,	TAD LTKNT
	TAD OFFKNT
	SNA CLA
	DCA NOCOMP	/COMPILE AGAIN
	STA
	TAD LTKNT
	SPA
	JMP ER71	/MISMATCHED GT
	DCA LTKNT	/DECREMENT LT COUNT
	TAD NOCOMP
	SNA CLA
	JMP I (RSETLN	/IGNORE LINE
BLNKLN,	TAD Z101
	DCA I (INPLIN+1
	TAD Z101
	DCA I (INPLIN+2
	JMP I (RSETLN
ER71,	JMS I ZERROR
	ERR71
NOCOMP,	0		/1 MEANS DON'T COMPILE
LTKNT,	0		/NUMBER OF NESTED LT'S
REGCOM,	CLA
	TAD NOCOMP
	SNA CLA
	EXIT CCP
	JMP BLNKLN
/NESTED CONDITIONALS NOT WORKING
/REACTIVATE WHEN COUNT RETURNS TO ACTIVATING ONE (NOT 0)
/CHECK IN END OVERLAY FOR HANGING NEST
/CAN'T DEFINE USE UNDEFINED CONDITIONAL IN MIDDLE OF RECORD
OFFKNT,	0		/NEG OF LT COUNT WHEN COMP WENT AWAY

IMAGE,	TAD	ZM15		/CHECK FOR COMMA
	SZA CLA
	JMP ILLDIM
	CLL CML RTL
	AND	TYPE
	SNA CLA
	JMP I (IMGERR
	STL RAL
	AND TYPLFT
	SNA CLA
	JMP I (IMGERR	/REALLY SEP ERROR
	IAC			/TYPE REQUIRED IS ALPHA
	DCA	TYPE
	JMS I	ZEXPR		/GET IMAGE STRING
	TAD	(IMAGOP
	JMS I	ZCODE
	JMP I ZNXTSTM
ILLDIM,	CALL ZERROR
	ERR16
	PAGE

PRINT,	0		/PRINTS THE NEXT SOURCE LINE
	SNA CLA
	ISZ	LINKNT
	SKP
	JMS	EJEKT
	TAD I	PRINT
	CALL (CDOIOC
	CLL
	TAD LINKNT
	TAD I (SUPLCT
	DCA LINKNT
	SZL
	JMS EJEKT
	ISZ	PRINT
	JMP I	PRINT
EJEKT,	0		/PERFORM TOP OF FORMS
	TAD (-65	/55 LINES PER PAGE
	DCA LINKNT	/RESET LINE COUNTER
	TAD (214
	CALL LP8PC	/PRINT FORM FEED
	ISZ PGNM	/INCR PAGE NUMBER
	TAD PGNM
	CALL OTOD	/CONVERT TO DECIMAL
	CDF 10
	DCA I (PAGNUM	/INSERT
	CDF 0
	TAD HEAD
	CALL (CDOIOC
	CALL ZPCRLF
	TAD SUBHD
	CALL (CDOIOC
	CALL ZPCRLF
/PAGE # AND DATE?
	EXIT EJEKT	/RETURN
PGNM,	0		/PAGE NUMBER
HEAD,	HEADING-1
SUBHD,	SUBHDG-1

/THIS ROUTINE INSERTS LINE NUMBER IN INPUT BUFFER.
/FORMAT OF INPUT BUFFER
/LOCATION	ORIGINAL USE	NEW USE
/INPLIN		NOT USED	NEW WC
/INPLIN+1	NOT USED	DIG1,DIG2
/INPLIN+2	OLD WC		DIG3,DIG4
/INPLIN+3	OLD LINE#	BLANK,BLANK
/INPLIN+4	START OF TEXT	START OF TEXT
GETLIN,	0		/READ A NEW LINE
	TAD Z7700
	DCA LENGTH	/SET LENGTH
	CLA STL RTL	/READ FILE 0
	CALL RDOIO
	INPLIN+1	/BUFFER ADDR -1
	JMP I (NOEND	/IF EOF, END MISSING
	STA CLL RAL
	TAD I (INPLIN+2	/INCREMENT WC BY 2
	DCA I (INPLIN	/INSERT
	TAD LINENO
	DCA OLDLNO	/SAVE OLD LINE #
	TAD I (INPLIN+3
	DCA LINENO	/SET NEW LINE #
	TAD LINENO
	JMS DECI
	DCA I (INPLIN+1	/INSERT
	TAD LOD		/GET NEXT 2 DIGITS
	DCA I (INPLIN+2	/INSERT
	TAD Z101	/GET 2 BLANKS
	DCA I (INPLIN+3	/INSERT
	TAD (6		/RESET CHAR POINTER
	DCA CHRPTR
	JMP I	GETLIN		/RETURN

DECI,	0
	DCA N1
	DCA TEST
	TAD N1
DECILP,	CLL
	ISZ TEST
	TAD (-144
	SZL
	JMP DECILP
	TAD (144
	CALL OTOD
	DCA LOD
	STA
	TAD TEST
	CALL OTOD
	EXIT DECI
N1,	0
TEST,	0

/ENTER WITH STREF PTING TO ENTRY
COMN,	0
	TAD STREF
	TAD (5
	DCA STREF
	ISZ I STREF
	ISZ STREF
	TAD I STREF
	EXIT COMN
CLEAR,	CLA CLL CML RTL
	AND TYPE
	RAR
	TAD	(CLEARA	
	JMP	CLSTCM
INKR,	DCA RIGHT	/WANT LEFT SIDE
	STL RTL
	DCA TYPE	/WANT DECIMAL
	CALL ZEXPR
	TAD (INCROP
CLSTCM,	CALL ZCODE
	JMP I ZNXTSTM
TRYLIT,	TAD RIGHT
	SZA CLA
	JMS I	(LITERL		/IS OPERAND A LITEAL?
	JMP I	(MSNGOP		/NO, MISSING OPERAND
	TAD	OPRAND		/YES, SAVE PARAMETERS
	DCA	EXTMP1
	TAD	SYMNUM
	DCA	EXTMP2
	CALL (TYPCHK
	JMP I	(WASLIT		/GO DO REST
	PAGE

/3400-4400 IS PROC OVERLAY OF BLOCK
BLOCK,	JMS I	ZNAME		/LOOK FOR "BLOCK"
	JMP I (NOBL	/MAYBE STARTS WITH ","
	TAD	NAME1
	TAD	(-4355		/"BL"
	SNA	CLA
	TAD	NAME2
	TAD	(-6044		/"OC"
	SNA	CLA
	TAD	NAME3
	AND	Z7700
	TAD	(-5400		/"K"
	SZA	CLA
	JMP I 	(TRYREC
	JMS I	ZRESET		/RESET CHAR POINTER
	JMS	I ZSKIP		/SKIP OVER FIRST 5
	-5
RECORD,	TAD SYMEND	/SET STREF
	IAC
	DCA I (STREF
	TAD	L7000
	DCA	BLNAME
	JMS I	ZNAME	/GET BLOCK NAME
	JMS I (DUMMY	/NO BLOCK NAME
	JMS I	ZLOOKUP
	TAD I	OPRAND		/CHECK TYPE
	CLL RAL
	SZA	CLA
	JMP	I (ER12		/IF ALREADY DEFINED, BAD
	RAR
	TAD	Z10		/SET TYPE TO "BLOCK"
	DCA I	OPRAND
	CDF 0
	TAD	BLKOPT
	SZA CLA		/WAS LAST BLOCK AN OVERLAY?
	JMP	NOVA	/YES
	TAD	RECSIZ	/NO
	CIA
	DCA	LASIZ
NOVA,	JMS I (FIX
	DCA	BLKOPT
	DCA COPT		/NEEDED FOR CHAIN OVERLAYS
	DCA	RECSIZ
BLKLUP,	JMS I	ZNXTCHR
	JMP	NOOPTN
	TAD	ZM15
	SZA CLA
	JMP	I (ER56
	JMS I	ZNXTCHR
L7000,	NOP
	TAD	(-71		/WE HAD A COMMA, LOOK FOR X
	SNA		/IS IT "X"?
	JMP XOPT	/YES
ER45,	JMS I ZERROR
	ERR45		/BAD OPTION
XOPT,	ISZ BLKOPT	/NOTE X OPT
	JMP BLKLUP	/MORE OPTIONS?

NOOPTN,	TAD	BLKOPT
	SNA	CLA
	JMP	NOX
	TAD	OLDBLK		/OPTION IS ",X"
	DCA	BYTORG		/DO OVERLAY
	TAD HIOLDBLK
	DCA HIORG
	DCA	COPT	/X IMPLIES NO C
	JMP YOX
NOX,	DCA LASIZ
/YOX,	TAD HIORG
/	RAR
/	CLA
YOX,	STL		/MIGHT WASTE 2 WDS AT HALF-FLD BDRY
	TAD BYTORG
	RAR
	CLL IAC
	SNL CLA
	JMP .+3
	ISZ HIORG
	DCA BYTORG
	CALL (ROUND
	TAD BYTORG
	DCA OLDBLK	/FIX ELUSIVE BUG
	TAD HIORG
	DCA HIOLDBLK
	ISZ	OPRAND		/POINTER TO DIMENSION
	IAC
	CDF SFLD
	DCA I	OPRAND		/SET IT TO 1
	ISZ	OPRAND
	TAD	OPRAND		/SAVE PTR TO BLK SIZE
	DCA	OBSIZE
	TAD HIORG
	DCA I OPRAND
	ISZ	OPRAND
	TAD	BYTORG
	DCA I 	OPRAND		/STORE BLOCK ORIGIN
	ISZ BYTORG
	ISZ BYTORG
	CDF 0		/CAN'T POSSIBLY BE SKIPPED
	JMP I	ZNXTSTM		/GET BLOCK STUFF
LASIZ,	0		/NEG OF SIZE OF FIRST RECORD IN OVERLAY GROUP

PATCH2,	0
	TAD	RECSIZ
	CLL CML
	TAD	TSIZE
	SNL		/NEW
	JMP ER20	/NEW
	DCA	RECSIZ
	TAD	RECSIZ
	TAD	LASIZ
	SZL SNA CLA	/CHECK FOR OVERFLOW (DOUBLE CHECK)
	EXIT	PATCH2
ER20,	CALL	ZERROR
	ERR20		/OVERLAYOR LARGER THAN OVERLAYEE
HIOLDBLK,0
	PAGE

DUMMY,	0		/CREATE DUMMY NAME
	CLA IAC
	DCA NAME1
	CDF SFLD
	DCA I Z3	/UNDEFINE IT
	CDF 0
	DCA	BLNAME
	EXIT DUMMY	/RETURN
DINIT,	JMS I	ZNXTCHR		/LOOK FOR DECIMAL INIT.
	JMP I	(ENDDAT-1
	TAD	ZM15
	SZA	CLA
	JMP I (ER56	/NOT ","
	TAD	L40
	DCA	SIGN		/40 IS NEGATIVE
	JMS NYPD	/LOOK FOR P OR D
	JMP I (ENDDAT-1	/FOUND P, OR D OR S
	TAD (-6		/IS IT "-"?
	SNA
	JMP	.+5
	TAD	(16-14
	SZA	CLA
	JMS I	ZBACKUP
	DCA SIGN	/0 IS POSITIVE
	JMS I (RLINIT
GDINIT,	JMS I	ZNXTCHR
	JMP	ENDNUM
	TAD (-16
	SNA		/IS IT "-"?
	JMP ENDNU	/YES
	TAD (16		/RESTORE CHAR
	JMS I	NUMBER
	JMP	ENDFLD
	DCA Y5
	TAD Y5
	CALL (RLPUTC
	JMP	GDINIT
ENDNU,	TAD L40		/NEGATIVE
	DCA SIGN
	CALL ZNXTCHR
	JMP ENDNUM

ENDFLD,	CALL ZNXTCHR
L40,	40		/DNO
	TAD ZM15
	SZA CLA
	JMP ER43
	CALL ZBACKUP
ENDNUM,	STA
	TAD I (RLCNT
	DCA I (RLCNT
	TAD Y5
	TAD SIGN
	CALL (RLPUTC
	JMS RLFINI
	JMP DINIT
SIGN,	0
RLFINI,	0
	TAD I (RLCNT
	CIA
	TAD ELSIZE
	SZA CLA
	JMP ER51
	TAD (LBUFR-1
	DCA X0
	STA
	TAD I (RLCNT
	CLL CML CMA RAR
	DCA ELCNT
	TAD I X0
	CALL ZCODE
	ISZ ELCNT
	JMP .-3
	JMS I (BUPD
	ISZ CRCNT
	EXIT RLFINI
	CALL ZERROR
	ERR50
ER51,	CALL ZERROR
	ERR51

ER46,	CALL ZERROR	/DATA INIT MISSING
	ERR46
ER43,	CALL ZERROR	/BAD DECIMAL CONSTANT
	ERR43
Y5,	0
NYPD,	0
	CALL ZNXTCHR
	JMP ER46
	TAD (-64	/IS IT S?
	SNA
	JMP SOPT	/YES
	TAD Z3		/BUT IS IT P?
	SZA
	JMP NOPP	/NO
	STL RTL		/2
NYGO,	CLL CMA RAL	/-6 OR -2
SOPT,	TAD (12		/4 OR 10 OR 12
	DCA PFLAG
	JMP I NYPD
NOPP,	TAD (61-45
	SNA
	JMP NYGO
	TAD (45-65	/LOOK FOR ,T
	SZA
	JMP NOD		/NOPE
	IAC
	JMP SOPT	/MARYJANE LIVES
NOD,	TAD (55
	ISZ NYPD
	EXIT NYPD	/RETURN WITH IT-10 IN AC
/P - TYPE 4 RECORD
/D - TYPE 10 RECORD
/S - TYPE 12 RECORD
/T - TYPE 13 RECORD
	PAGE

NOBL,	JMS I (DUMMY
	CALL ZCOMA
DATASP,	JMS I	ZLOOKUP
	TAD I	OPRAND
	CLL RAL
	CDF 0
	SZA	CLA
	JMP	I (EER12
	JMS	I (DATNUM
	DCA	RCNT
	TAD	RCNT
	CMA
	DCA	CRCNT
	JMS I	ZNXTCHR
	JMP	I (ER52
	TAD (-42
	DCA	TYPE
	CALL (DATNUM
	DCA ELSIZE
	TAD	ELSIZE
	CIA CLL
	DCA	CELSIZ
ADUP,	TAD	RCNT
	SZL
	JMP I (ER15	/WOW IS BIG!
	ISZ	CELSIZ
	JMP ADUP
	DCA	TSIZE
	TAD ELSIZE
	AND D7000
	SZA CLA
	JMP I (ER15	/IS BIG
	CALL	(PATCH2
	CLA IAC
	TAD	RECSIZ
	AND	BLNAME
	SZA CLA
	JMP I	(ER20	/RECORD TOO BIG
	DCA PFLAG	/ZERO P FLAG
	CALL (PATCH	/SAVE INFO FOR ,P
	TAD BLKOPT
	SZA CLA
	JMP NOCLR
	TAD TSIZE
	DCA SIZE
	TAD TYPE
	SNA CLA
	JMP NOCLR
	CALL ZCDUMP
XCLEAR,	DCLEAR
	JMS I (CORG	/OUTPUT SIZE-ORIGIN
	TAD SIZE
	CIA
	CALL ZCODE	/NEED 12-BIT SIZE HERE (NEW)
NOCLR,	TAD ELSIZE
	DCA SIZE
	TAD TYPE
	SZA CLA		/IS TYPE "A"?
	JMP I (DINIT	/NO
AINIT,	JMS I	ZNXTCHR		/LOOK FOR ALPHA INITIALIZATION
	JMP	I (ENDDAT
	TAD	ZM15
	SZA	CLA
	JMP	I (ER14
	CALL (NYPD
	JMP I (ENDDAT
	SZA CLA
	JMP I (ER47
	JMS RLINIT
GETAI,	JMS I	(GETCHR		/GET NEXT CHAR, KEEP BLANKS
	JMP I (ER47
	TAD	ZM10		/LOOK FOR CLOSING '
	SNA
	JMP	FINAI
	TAD	Z10
	JMS RLPUTC
	JMP	GETAI
FINAI,	CALL (RLFINI
	JMP	AINIT

RLINIT,	0
	TAD TYPE
	SNA CLA
	JMP SRLINI
	TAD BLKOPT
	TAD TSIZE
	CIA
	TAD ELSIZE
	SNA CLA
	DCA I (CODBUF
/	DELETE PREVIOUS CODE ENTRY!
SRLINI,	CALL ZCDUMP
	DATAIN
	CALL (CORG
	DCA RLCNT
	JMP I RLINIT
RLPUTC,	0
	CALL KPUTC
	LBUFR-1
RLCNT,	0
	ISZ RLCNT
D7000,	7000
	EXIT RLPUTC
BUPD,	0
	CLL
	TAD BYTORG
	TAD ELSIZE
	DCA BYTORG
	SZL
	ISZ HIORG
	EXIT BUPD
	PAGE

	IAC
ENDDAT,	IAC
	CDF SFLD
	TAD I OPRAND
	DCA I	OPRAND
	ISZ	OPRAND
	TAD	RCNT
	DCA I	OPRAND
	TAD SAVHI
	DCA HIORG
	ISZ	OPRAND
	TAD	ELSIZE
	CLL RTL
	RAL
	TAD HIORG
	DCA I	OPRAND
	ISZ	OPRAND
	TAD SAVBYT	/THIS IS BETTER THAN ORGBYT
	DCA BYTORG
	TAD	BYTORG
	DCA I	OPRAND
	CDF 0
	TAD TSIZE
	DCA ELSIZE	/BUPD WANTS ELSIZE
	CALL (BUPD
	TAD PFLAG	/P?
	SNA
	JMP I	ZNXTSTM
	DCA TYPE4
	CALL ZCDUMP	/CREATE TYPE 4 RECORD
TYPE4,	COMMAP
	TAD NAME1	/OUTPUT NAME
	CALL ZCODE
	TAD NAME2
	CALL ZCODE
	TAD NAME3
	CALL ZCODE
	TAD SV1
	CALL ZCODE	/OUTPUT SIZE-ORIGIN
	TAD SV2
	CALL ZCODE
	JMP I ZNXTSTM	/NEXT STMNT
/NOTE: ,P CAN FOLLOW A DEFAULT INITIAL VALUE
SAVHI,	0
SAVBYT,	0
SV1,	0
SV2,	0

DIGIT,	0
NMBR,	0
DATNUM,	0
	TAD M4
	DCA DTCNT
NUMCNV,	DCA	NMBR
	JMS I	ZNXTCHR		/LOOK FOR FIRST DIGIT
	JMP NONUM		/IF NO CHARS, INCOMPLETE	JMS I	NUMBER		/TEST FOR DIGIT
	JMP	NONUM		/IN THIS CASE, BACK 1
	AND	L17		/STRIP OFF LEADING BITS
	TAD	M1
	DCA	DIGIT		/SAVE THIS DIGIT
	ISZ DTCNT
	JMP .+3
ER15,	CALL ZERROR	/ENTITY TOO LARGE
	ERR15
	TAD	NMBR		/MULTIPLY OLD NUMBER BY 10
	CLL RTL
	TAD	NMBR
	CLL RAL
	TAD	DIGIT		/NOW ADD NEW DIGIT
	JMP	NUMCNV		/GO STORE THE UPDATED NUMBER
NONUM,	CLA STL RTL	/2
	RAL		/4
	TAD	DTCNT
	SNA CLA		/IF NUMBER WASN'T THERE
	IAC		/MAKE IT 1
	TAD	NMBR
	SNA		/IF NUMBER WAS THERE AND WAS 0,
	JMP	ER15	/ITS AN ERROR
	JMP I	DATNUM	/RETURN WITH NUMBER IN AC

DTCNT,			/NO. MUST BE 1, 2, OR 3 DIGS.
FIX,	0
	TAD OLDBLK
	CIA
	TAD BYTORG
	CLL RAL
	CLL RAL
	CLL RAL
	TAD I (HIOLDBLK
	CDF SFLD
	DCA I OBSIZE
	CDF 0
	TAD BLKOPT
	SNA CLA		/WAS LAST BLOCK AN OVERLAY?
	JMP NOOV	/NO
	TAD REALBYT	/YES
	DCA BYTORG
	TAD REALHI
	DCA HIORG
NOOV,	TAD BYTORG
	DCA REALBYT
	TAD HIORG
	DCA REALHI
	EXIT FIX	/RETURN
REALBYT,0		/NEXT REAL BYTE LOC
REALHI,	0
PATCH,	0
	TAD TYPE
	SZA
	TAD (-3
	SZA CLA
	JMP ER52	/IT'S NOT A OR D
	TAD ELSIZE
	CLL RTL
	RAL
	TAD HIORG
	DCA SV1
	TAD BYTORG
	DCA SV2
	TAD BYTORG
	DCA SAVBYT
	TAD	HIORG
	DCA	SAVHI
	EXIT PATCH
ER52,	CALL ZERROR
	ERR52		/NOT A OR D
	PAGE

	*4400
SWITCH,	0
/	ARG IN AC
	DCA TM2
	TAD I (LISTSW
	RTR
	RTR
	RTR
	AND L77
	DCA TM1
	TAD TM1
	JMS I	(NUMBUR
	JMP N2		/IT'S A DIGIT
	TAD TM1		/IT'S NOT
	JMS GOPT
	TAD TM2		/NO
	JMS I	(NUMBUR	/DIGIT?
	EXIT SWITCH	/YES SIR
N2,	TAD TM2		/NO SIR
	JMS GOPT
/	ISZ I (LISTSW	/"??"?
/	EXIT	SWITCH
/	DCA I (QPRNT	/YES
	EXIT SWITCH

DEIGHT,	0
	TAD I SYSDAT	/GET DATE
	DCA DATEM	/SAVE IT
	TAD DATEM
	CLL RTL
	RTL
	RAL
	AND L17
	DCA	TM1		/SAVE MONTH FOR LATER
	TAD	TM1
	CLL RAL
	TAD (MONLST-3
	DCA X2
	TAD I X2
	CDF 10
	DCA I (MONTH1
	CDF 0
	TAD I X2
	CDF 10
	DCA I (MONTH2
	TAD DATEM
	AND L7
	DCA	TM2		/SAVE YEAR FOR LATER
	TAD	TM2
	CLL RTL
	RTL
	RTL
	TAD (2301
	DCA I (YEAR
	CDF 0
	TAD DATEM
	CLL RTR
	RAR
	AND (37
	DCA	DATEM		/SAVE DAY FOR LATER
	TAD	DATEM
	CALL OTOD
	CDF 10
	DCA I (DAY
/FIGURE OUT DAY OF WEEK
	CDF 0
	TAD	TM2
	CLL RTR
	SNL SMA			/CHECK FOR A LEAP YEAR
	JMP	LEAP		/WE GOT ONE!
	ISZ I	(JAN		/IF NOT, FUDGE UP THE CONSTANTS
	ISZ I	(FEB
LEAP,	AND	(37
	TAD	TM2
	TAD	(132		/72 + 72/4 IN DISGUISE
	TAD	DATEM
	DCA	DATEM
	TAD	TM1
	JMS I	(PART2		/GO TO NEXT KLUDGE AREA
	EXIT DEIGHT	/THAT'S A SWITCH

/
GOPT,	0
	TAD (-17	/ /O IS THE ONLY ONE LEFT
	SZA
	JMP	TSTNSW
	TAD	(7200
	DCA I	(OPTMZ1
	TAD	(7200
	DCA I	(OPTMZ2	/DON'T OUTPUT LINE NUMBERS
	ISZ I	(OPTMZ3
TSTNSW,	IAC
	SZA CLA
	JMP I GOPT
SETNLS,	STL CLA RAR	/LSTSW=4000 MEANS NOLIST
	DCA LSTSW
	JMP I GOPT
SCRCHK,	TAD	(400		/LOOK AT FIRST BLOCK ENTRY IN 
	JMS I	SYSHND		/DIRECTORY TO DETERMINE BINARY SCRATCH AREA
	0110			/LENGTH.  READ 1 PAGE, BLOCK 1 INTO
	0000			/PAGE 0 FIELD ONE
	0000			/SEGMENT 0
	CDF 10
	TAD I	(1		/GET FIRST BLOCK OF FIRST FILE
	CDF 00
	AND	(7760		/ROUND OFF TO SEGMENT #
	CLL RTR
	RTR
	CIA
	DCA I	(TOPF
	JMP I	(SCROK		/CONTINUE INIT CODE
/
	PAGE

CODBUF,	-1		/KLUDGE TO CDUMP
EMSG,	4663	/ER
	6360	/RO
	6364	/RS
	0101	/
NUMBUR,	0		/SKIP IF NOT STRIPPED DIGIT & STUFF
	TAD (-72
	CLL
	TAD (12
	SNL
	JMP YECCH	/BAD #
		/SW ROUTINE TO FIND LOG UNIT# ASSOC WITH DT #
	TAD SYSHND
	CIA
	DCA MATCH
	TAD (UTBASE-1
	DCA X0
	TAD (-20
	DCA COUNT
	DCA LOGICAL
SLOOP,	TAD I X0
	TAD MATCH
	SNA CLA
	JMP GOTCHA
	ISZ LOGICAL
	CLA STL RTL
	TAD X0
	DCA X0
	ISZ COUNT
	JMP SLOOP
	HLT		/DTA NOT ASSIGNED
GOTCHA,	TAD LOGICAL
	DCA BUNIT	/SOMEONE'S BEEN SLEEPING IN MY UNIT AND HERE IT IS
	EXIT NUMBUR
YECCH,	CLA
	ISZ NUMBUR	/BUMP
	EXIT	NUMBUR
LOGICAL,0
COUNT,	0
MATCH,	0

/
PART2,	0		/2ND PART OF KLUDGE TO GET DAY OF WEEK
	TAD	(JAN-1
	DCA	TM1
	TAD I	TM1		/GET MAGIC # FROM TABLE
	TAD	DATEM
DIV7,	CLL
	TAD	(-7
	SZL
	JMP	DIV7
	TAD	L7
	CLL RAL
	TAD	(WEEKDY-1
	DCA	GETWKP
	AC7776=	CLA CLL CMA RAL
	AC7776
	JMS I	MOVE
	CDF 10
GETWKP,	0
	WKDAY-1
	JMP I	PART2
/
WEEKDY,	6442	/SA
	6501	/T
	6466	/SU
	5701	/N
	5660	/MO
	5701	/N
	6566	/TU
	4601	/E
	7046	/WE
	4501	/D
	6551	/TH
	6663	/UR
	4763	/FR
	5201	/I

MONLST,	1653;4257;1647
	4643;1656;4263
	1642;6163;1656
	4272;1653;6657
	1653;6655;1642
	6650;1664;4661
	1660;4465;1657
	6067;1645;4644
/
/A MAGICAL TABLE
JAN,	0
FEB,	3
	4;0;2;5;0;3;6;1;4;6
NOFGBG,	TAD	(11		/HERE IF MCOMP RUN WITH LESS THAN 12K
	JMS I	CDOIO		/MAYBE 16K WITH FGBF GOING
	NOCORE-1
	7600			/NEVER RETURN HERE
	JMP I	.-1		/NIFTY, NO?
/
	PAGE

	FIELD 1		/OVERLAYS GO IN FIELD 1 FOR ASSEMBLY PURPOSES
	*1400
ENDOVO=.
	NOPUNCH
	*1400
	ENPUNCH
ENDOVF=.
/TYPE	/	/	/KLUDGE
/0	0	14	00003
/1	2	2	10000
/2	4	4	00001
/4	10	10	00002
/10	20	20	00004
/20	40	40	00010
/2000	4000	14	00003
/4000	0	16	10003
SOT,	0		/2 OR 3 PLACE PRINT ROUTINE
	CALL (DECI
	AND L77
	DCA SOTM
	TAD SOTM
	TAD (-21
	SZA
	TAD (20
	TAD Z101
	CALL (PUSHX2	/INSERT IN PRINT BUFFER
	TAD LOD
	CALL (PUSHX2	/LOW ORDER PART TOO
	EXIT SOT
SOTM,	0
/	THIS WAS GOLOAD

PTCH3,	0
	CALL (BLPAD
	TAD (4265	/"AT"
	CALL (PUSHX2
	TAD (155	/" L"
	CALL (PUSHX2
	TAD (5257	/"IN"
	CALL (PUSHX2
	TAD (4601	/"E "
	CALL (PUSHX2
	ISZ X0
	ISZ X0
	CALL (POPX0
	CDF 0
	CALL (DECI
	CALL (PUSHX2
	TAD LOD
	CALL (PUSHX2
	CALL (PUSHX2
	EXIT PTCH3
ENDST,	TAD I (LTKNT
	SZA CLA
	JMP CCPFTL
	TAD NSYMS
	IAC
	CDF 10
	DCA I (TYPE3+2
	CDF 00
	TAD I (PROCSYM
	IAC
	CDF 10
	DCA I (TYPE3+3
	CDF 00
	TAD	L100
	DCA I	(SBT
	STL CLA RAR
	DCA LENGTH
	TAD ERKNT
	SZA CLA
	JMP LEV

	TAD (11
	CALL RDOIO
	TYPE3-1
L100,	100
LEV,	TAD (STITLE-1	/CHANGE HEADING
	DCA I (SUBHD
	CDF 10
	TAD	(-6
	JMS I	MOVE
	CDF 10		/CHANGE THE HEADER LINE
	HEAD2-1		/TO READ "STORAGE MAP LISTING"
	CMPLTN-1	/INSTEAD OF "COMPILATION LISTING"
	STA
	DCA LINKNT
	STA
	DCA X1
	TAD NSYMS
	CIA
	CLL RAL
	JMS PUSHX1
	TAD (3400
	DCA R3
	CDF 0
	JMP I (ENDST2
CCPFTL,	JMS I (FATAL
	ERR71
POPX0,	0
	CDF SFLD
	TAD I X0
	JMP I POPX0
PUSHX1,	0
	CDF SFLD
	DCA I X1
	JMP I PUSHX1
PUSHX2,	0
	CDF 10
	DCA I X2
	JMP I PUSHX2
BINLEN,	0
	TAD	BOUTLN
	AND	L7400
	CLL RAL
	TAD	HIBOUT
	RTL
	RTL
	DCA	HIBOUT
	JMP I	BINLEN
VERSN,	VERSON
BINXT,	BINEXT
/
	PAGE

ENDST2,	CDF SFLD
	TAD (6		/START AT ENTRY 1!!!!
	DCA X0
	TAD (-31
	CDF 10
	DCA I L7001	/SET WC
	CDF 0
	CALL (ROUND	/ROUND UP TO EVEN BYTE
	TAD I (HILIT	/DOUBLE PREC DIVIDE BY 2
	CLL RAR
	DCA PROGH
	TAD I (LITORG
	RAR
	CLL
	TAD	NSYMS
	TAD	NSYMS
	IAC		/ADD 1 FOR WC PRECEEDING SYMBOLS
	DCA PROGL
	SZL
	ISZ	PROGH
L7001,	IAC
	DCA NSKNT
	TAD (ENDLUP
	DCA I (ERET
/X0 PTS TO SYMBOL TABLE
/X1 PTS TO COMPACTED SYMBOL TABLE
/X2 PTS TO PRINT BUFFER 
/X4 PTS TO TYPE NAME
/R3 POINTS TO DDT SYMBOL TABLE

ENDLUP,	CDF SFLD
	TAD L7001
	DCA X2
	TAD (1717
	DCA UNTEM
	CALL (POPX0
	SNA
	JMP I (ISZN
	SPA
	DCA UNTEM
	CLA
	TAD NSKNT
	RTR
	RTR
	RTR
	CALL (BFOO
	TAD NSKNT
	CALL (BFOO
	CALL (BLPAD
	ISZ NSKNT
	TAD UNTEM
	CALL (PUSHX2	/PRINT NAME
	DCA EFL
	CALL (POPX0
	CALL	(NULCHR
	CALL (PUSHX2
	CALL (POPX0
	CALL	(NULCHR
	CALL (PUSHX2
	JMS I (BLPAD
	CALL (POPX0	/GET TYPE
	CLL RAL
	DCA NTEM
	TAD NTEM
	SMA SZA
	JMP UNUN
	DCA EFL		/UNRESOLVED LABEL REFERENCE
	RTL
	TAD (14		/PT TO "UNDEF"

UNUN,	CLL RTR		/FUDGE
	CML
	SZA SNL
	STA
	TAD (TYPTBL
	DCA UNTEM
	CDF 0
	TAD I UNTEM
	DCA X4
	CLL STA RTL	/-3
	DCA ENDKNT
UNUN01,	CDF 10
	TAD I X4
	CALL (PUSHX2	/PRINT TYPE
	ISZ ENDKNT
	JMP UNUN01
	TAD NTEM
	SNA CLA
	CALL (PUSHX2
	TAD EFL
	SNA CLA
	JMP I (AAAAAA
	JMS I (ABORT
	CALL (PTCH3
	JMP I (NOOF
UNTEM,	0
/
	PAGE

AAAAAA,	JMS I (BLPAD
	CALL (POPX0	/GET DIMENSION
	CDF 0
	CALL (SOT	/CONVERT TO DECIMAL
	JMS I (BLPAD
	CALL (POPX0	/GET SIZE, H.O. ORIGIN
	DCA SIZ
	CALL (POPX0
	DCA ORI		/GET L.O. ORIGIN
	TAD NTEM
	TAD ZM10
	SZA CLA
	JMP NOOF
	CLL
	TAD ORI
	TAD PROGL
	DCA ORI
	RAL		/FIXED
	TAD PROGH
	TAD SIZ
	DCA SIZ
NOOF,	TAD SIZ
	CALL (PUSHX1
	TAD ORI
	CALL (PUSHX1	/COMPACT
	TAD SIZ
	CLL RAR
	CLL RAR
	CLL RAR
	CDF 0
	SNA
	TAD (1000
	CALL (SOT	/PRINT SIZE
	JMS I (BLPAD
	TAD SIZ
	AND L7
	TAD (121
	CALL (PUSHX2
	TAD ORI
	RTR
	RTR
	RTR
	JMS BFOO
	TAD ORI
	JMS BFOO
	CDF 0
	TAD EFL
	SZA CLA
	JMP ZPR
	TAD LSTSW
	SZA CLA
	JMP I (ENDLUP
ZPR,	CALL ZPRINT
	7000
	JMP I (ENDLUP

BFOO,	0
	DCA FOOT
	TAD FOOT
	AND L7
	DCA FOT
	TAD FOOT
	RTL
	RAL
	AND (700
	TAD FOT
	TAD (2121
	CALL (PUSHX2
	EXIT BFOO
FOOT,	0
ISZN,	CDF 10
	TAD ERKNT
	SZA
	CALL OTOD
	SNA
	TAD (5760
	DCA I (ERTXT	/INSERT NO. OF ERRORS IN MSG
			/COMBINE ERRORS WITH SYMBOLS TEXT
	STA
	TAD ERKNT
	SZA CLA
	JMP .+3
	TAD Z101	/CORRECT ENGLISH GRAMMAR
	DCA I (S	/BLANK OUT "S"
	CLL
	TAD LOCCTR
	TAD PROGL
	DCA	LOCCTR
	RAL
	TAD	PROGH	/ADD CARRY INTO HIGH ORDER
	TAD HILOC
	DCA HILOC
	JMP I (PREEND

FOT,
ABORT,	0
	TAD (1313	/"**"
	CALL (PUSHX2
	TAD ERKNT
	SZA CLA
	JMP OK
	CDF 0
	CLA IAC
	CALL (SFINI
OK,	ISZ ERKNT
	EXIT ABORT
	PAGE

LPTFG,	0		/SET TO 0400 IF INIT (N,LPT) WAS FOUND
PREEND,	TAD BYTORG		/GET HERE WITH CDF 10
	CLL RAR
	DCA BYTORG
	TAD HIORG
	RAR
	DCA HIORG
	CIF 10
	CALL	(LPTSPL
	TAD BYTORG
	DCA	BYTX
	RAL
	TAD HIORG	/ DATA FIELD STILL = 10
	CLL RTL
	CALL OTOD
	DCA I (JOBCOR+1
	TAD	BYTX
	CALL (DECI
	DCA I (JBCOR
	TAD LOD
	DCA I (JBCOR+1
	STA		/DATA FIELD = 10 FOR A WHILE
	TAD NSKNT
	CALL (DECI
	DCA I (STLENT+1
	TAD LOD
	DCA I (STLENT+2
	TAD	LPTFG		/PREDETERMINE CARRY
	CLL
	TAD	LOCCTR		/LOW ORDER PROGRAM SIZE
	CLA RAL			/DISCARD SUM, RETAIN CARRY
	TAD HILOC
	CLL RTL
	CALL OTOD
	DCA I (PRGCOR+1
	TAD	LPTFG
	TAD	LOCCTR
	CALL (DECI
	DCA I (PRGLCS
	TAD LOD
	DCA I (PRGLCS+1

	CDF 00
	TAD LSTSW
	SZA CLA
	JMP EPI2
	CALL ZPCRLF
	CALL ZPRINT
	STLENT-1
	TAD I	(OPTMZ3
	SNA CLA		/ /O?
	JMP	EPI2
	CALL	ZPCRLF
	CALL	ZPRINT
	OPTMSG-1
EPI2,	TAD ERKNT
	SZA CLA
	JMP LEAVE
	TAD (SFLD+1
	CALL RDOIO
	-1
	214
	CLA IAC
	CALL (SFINI
	DCA	X2
	TAD I	(TOPFLD
	JMP I (EPI1

	CP-1
TYPTBL,	AL-1
	DE-1
	LA-1
	UN-1
	RE-1
K3400,	3400
KM3400,	-3400
K377,	377
	MD-1	/MUST BE AT TYPTBL+10
LEAVE,	TAD TTOCHR
	DCA LP8PC
	DCA LINKNT
	CDF 10
	TAD I (ERTXT
	DCA I (XLVTXT
	CDF 00
	DCA I CTRLO
	CALL ZPRINT
	XLVTXT-2
	JMP I L7600
MOVEX1,	0		/MOVE PROLOG STUFF INTO RECORD
MOVEX,	TAD (201
	DCA X1
MOVEXL,	TAD I MOVEX1		/GET ADDRESS OF DATA
	ISZ MOVEX1
	SNA			/ZERO ENDS LIST
	JMP I MOVEX1
	DCA MOVEX		/USED AS TEMPORARY
	TAD I MOVEX		/PICK UP DATA
	DCA I X1
	JMP MOVEXL
NULCHR,	0		/CALL TO CHECK AC FOR NULL CHAR
	SNA		/MAYBE BOTH NULL?
	TAD	Z101	/EASY TO FIX
	DCA	MOVEX1
	TAD	MOVEX1
	AND	L77	/HOW ABOUT LAST CHAR
	SNA CLA
	IAC
	TAD	MOVEX1	/CONVERT TO SPACE IF NECESSARY
	EXIT	NULCHR
/
	PAGE

EPI1,	RTR
	RAR
	AND L7
	CMA		/-NK-1
	TAD HILOC
	DCA X3
	TAD	LOCCTR
	AND	L7400
	TAD	(400
	TAD I	(LPTFG		/ADD 400 WORDS IF LPT IS TO BE USED
	DCA X4
	SZL
	JMP DONJOB
	TAD	BYTX		/GET PROG SIZE WITH BUFFERS
	AND	L7400
	TAD	(400		/ROUND UP TO NEXT BOUNDARY
	DCA	BYTX
	RAL			/WITH CARRY
	TAD	HIORG
	DCA	COPY
	CLA CLL CMA CML		/ALLOW FOR EXACT FIT
NXTJOB,	TAD BYTX
	TAD X4
	DCA X4
	RAL
	TAD	COPY
	TAD X3
	DCA X3
	SZL
	JMP DONJOB
	ISZ X2
	JMP NXTJOB
DONJOB,	TAD X2
	CALL OTOD
	CDF 10
	DCA I (NTERM
	CDF 00
	TAD LSTSW
	SNA CLA			/IF NO LIST THEN SEND CORE SIZE TO TTY
	JMP	NOTT
	TAD	TTOCHR
	DCA	LP8PC
	DCA	LINKNT		/PREVENT HEADINGS ON TTY
NOTT,	CALL ZPCRLF
	CALL ZPCRLF
	CALL ZPRINT
	PRGCOR-1
	CALL ZPCRLF
	CALL ZPRINT
	JOBCOR-1
	CALL ZPCRLF
	CALL ZPRINT
	NJOBS-1
	STA
	CALL ZPCRLF		/FORM FEED
EPI3,	TAD NSYMS
	IAC
	CLL RAL
	TAD BOUTLN
	DCA BOUTLN
	SZL
	ISZ HIBOUT
	TAD BUNIT
	SNA CLA		/COPY TEMP FILE?
	JMP BACKIN	/NO
	TAD	HIBOUT
	CMA
HBCNT,	DCA	.	/SUAVELY USES A TEMPORARY
	SKP
	JMS	COPY	/COPY A HUNK
	ISZ	HBCNT	/KEEP GOING?
	JMP	.-2	/YES
	TAD	BOUTLN	/GET LOW ORDER OUTPUT WORD COUNT
	AND	L7400
	SZA		/WATCH OUT IF ITS ZERO
	JMS	COPY	/IF NOT, COPY A TRUNCATED HUNK

BACKIN,	CALL SYSHND	/GO BACK AND INSERT
	0200		/READ OUTPUT
	0200		/INTO 200
	4		/THE HUNK
	CALL	(BINLEN
	CALL (MOVEX1		/MOVE DATA INTO RECORD AREA
	PROCNM			/# I/O BUFFERS PER JOB
	PROGH			/PC START
	PROGL			/IS ALSO END OF LITERALS
	HIBOUT			/LENGTH OF BINARY FILE
	NSYMS			/# SYMBOLS
	VERSN			/COMPILER VERSION NUMBER FOR MULTI
	BINXT			/BINARY FILENAME EXTENSION FOR 'SAVE'
	HILOC			/TOTAL PROGRAM LENGTH
	LOCCTR			/LOW ORDER LENGTH
	HIORG			/JOB AREA SIZE
	BYTORG			/LOW ORDER
	LPTFG			/LPT USE FLAG
	0			/ZERO TERMINATES LIST
	CALL SYSHND	/REWRITE
	4200
	200
	4		/LONG LIVE THE HUNK!
	JMP I GOPTR
COPY,	0		/TAPE COPY ROUTINE
	CLL CML RAR
	TAD	Z10	/SET UP A WRITE ONTO THE SYSTEM TAPE
	DCA	IOCTW2
	TAD	IOCTW2
	AND	(3670	/KEEP THE COUNT AND THE FIELD
	TAD	BUNIT	/TURN IT INTO A READ FROM BUNIT
	DCA	IOCTW1
	CALL	SYSHND
IOCTW1,	0
	0
	4		/BINARY WORK AREA
	ISZ	.-1	/BUMP IT
	CALL	SYSHND
IOCTW2,	0
	0
	4		/BINARY WORK AREA ON SYS
	ISZ	.-1	/BUMP THAT TOO
	JMP I	COPY	/RETURN
ENDOVL=.&7600+200
	PAGE

/ THIS STUFF STAYS IN FIELD 1
/
XX0=10		/FIELD 1 XR REGISTER
XLOOK,	0			/LOOKUP VAR IN SYMBOL TABLE
	DCA XSYMNUM	/ZERO SYMBOL # (MIGHT HAVE AC NON-ZERO)
	TAD I	(NAME1		/COMPLEMENT
	DCA	NAME1C		/THE
	TAD I	(NAME2
	DCA	NAME2C
	TAD I	(NAME3		/WORD
	DCA	NAME3C		/NAME.
	TAD XSYMNUM
	CLL RAL
	TAD XSYMNUM
	CLL RAL
	TAD XSYMNUM	/MULT SYMNUM BY 7
	TAD (-1
	DCA XX0		/SET PTR TO TABLE-1
	CDF SFLD		/SET FIELD
SYMLUP,	TAD I	XX0		/IS THIS END OF TABLE?
	SNA
	JMP	ENDTAB		/YES, MAKE NEW ENTRY
	CIA
	TAD	NAME1C		/IS THIS THE ONE?
	SZA CLA
	JMP	BUMP6		/NO
	TAD I	XX0
	CIA
	TAD	NAME2C		/SO FAR SO GOOD
	SZA CLA
	JMP	BUMP5		/NO
	TAD I	XX0
	CIA
	TAD	NAME3C		/ALMOST...
	SZA CLA
	JMP	BUMP4		/AW NUTS!
	TAD	XX0		/YES, THIS IT 
	IAC
	DCA	XOPRAND		/SET THE POINTER

XLOKND,	CIF CDF 00
	TAD XSYMNUM
	DCA I (SYMNUM
	TAD XX0
	DCA I (X0
	TAD XOPRAND
	DCA I (OPRAND
	CDF SFLD		/CALLING ROUTINES EXPECT THIS
	JMP I XLOOK
BUMP6,	IAC			/SKIP
BUMP5,	IAC			/THE REST
BUMP4,	IAC			/OF
	TAD	(3		/THIS
	TAD	XX0		/ENTRY
	DCA	XX0		/AND THEN
	ISZ	XSYMNUM		/BUMP SYMBOL NUMBER AND
	JMP	SYMLUP		/LOOP
ENDTAB,	CMA			/END OF TABLE
	TAD	XX0
	DCA	XX0
	TAD	NAME1C
	DCA I	XX0		/SO MAKE
	TAD 	NAME2C
	DCA I	XX0		/A NEW
	TAD	NAME3C
	DCA I	XX0		/ENTRY.
	DCA I	XX0		/WITH TYPE 0
	TAD	XX0
	DCA	XOPRAND		/(SAVE THE POINTER)
	DCA I	XX0		/AND 0 DIMENSION
	DCA I	XX0		/AND 0 ELEMENT SIZE
	DCA I	XX0		/AND 0 ORIGIN
	TAD	XX0
	DCA	XSYMEND		/SAVE NEW END OF TABLE
	DCA I	XX0		/ZERO E.O.T.
	CDF 00
	TAD XSYMEND
	DCA I (SYMEND
	ISZ I	(NSYMS		/BUMP # OF SYMBOLS
	TAD I	(NSYMS
	TAD	STS		/S.T. FULL
	SMA CLA
	ISZ XLOOK
	JMP XLOKND

NAME1C,	0
NAME2C,	0
NAME3C,	0
XSYMNUM,	0
XOPRAND,	0
XSYMEND,	0
STS,	-555		/- S.T. SIZE (IN ENTRIES)
LPTTST,	0
	DCA I	(WROPZ		/STORE DEVICE #
	TAD I	(WROPZ			/AND WAS IT THE LPT?
	TAD	(-105
	SNA CLA
	ISZ	LPTUSE			/PROBABLY NEVER SEE 4096 INIT'S
	TAD I	(WROPZ
	CLL RAL
	SPA SNA SNL CLA
	ISZ	LPTTST
	CIF 00
	JMP I	LPTTST
LPTUSE,	0
LPTSPL,	0			/HERE BECAUSE THERE'S NO ROOM LEFT
	CDF CIF 00
	TAD	LPTUSE
	SZA CLA
	TAD	(400		/SIZE OF LPT JOB AND USE INDICATOR
	DCA I	(LPTFG		/STORE USAGE INDICATOR IN FIELD ZERO
	TAD I	(PROCNM
	RTR
	RTR
	RAR
	CDF 10
	EXIT	LPTSPL
/
	PAGE

	*3400
PRCOVO=.		/USED TO RELOCATED PROC OVERLAY
	NOPUNCH
	*3400
	ENPUNCH
PRCOVF=.		/USED FOR ORIGIN AND LENGTH
GOTREL,	JMS I	ZNXTCHR		/LOOK FOR ANOTHER .
G537,	537
	TAD	(-17
	SZA CLA
	JMP ER25
	JMS I	ZEXPR	/NOW GET EXPR
	CALL ZRPAREN	/LOOK FOR )
	TAD	IFCCOD
	CLL CMA RTL	/MULTIPLY C.C. BY 20
	RTL
	TAD	G537	/ADD OFFSET TO MAKE MAGIC SKIP
	TAD	TYPE
	CALL ZCODE
	TAD CHRPTR
	DCA SAVE
	ISZ I (IFLG	/DON'T WANT COMPUTED GOTOS
	TAD (CML2-CMLIST	/FAKE OUT CMLIST
	JMP CMCHK

FORMS,	JMS	CKLET
	64		/CHECK FOR "S"
	CALL ZLPAREN	/GET LEFT PAREN
	CALL (IARG
	CALL ZCOMA
	CALL ZEXPR	/GET CHANNEL
	CALL ZRPAREN	/GET RIGHT PAREN
	TAD (FORMOP	/YES
	JMP CMNCOD
XMIT,	CALL ZLPAREN	/GET LEFT PAREN
	CALL (XARG
	TAD	(XMITOP		/OUTPUT XMIT CODE
LOKXM,	JMS I	ZCODE
	CALL ZNXTCHR	/LOOK FOR ","
	JMP I (ER56	/OH WELL
	TAD ZM15	/IS IT?
	SNA
	JMP GETEOF	/IT'S A COMMA
	TAD Z3
	SZA CLA		/IS IT A ")"?
	JMP I (ER56	/NO
	CALL ZBACKUP
	JMP GOTEOF

GETEOF,	CALL (GETLBL	/LOOK FOR LABEL
	TAD SYMNUM	/SET UP BRANCH TO IT
GOTEOF,	TAD (BRANCH	/OUTPUT BRANCH CODE
	JMP	I (CCLOSE
RETURN,	JMS RNSUB
	STA		/*** RETURN MUST BE STOP-1! ***
STOP,	TAD	(STOPOP
	JMP CMNCOD
IFCCOD,
RNSUB,	0		/CAN BE CALLED WITH AC .NE. 0
	TAD NAME3
	TAD (-6357
	SZA CLA
	JMP I ZNMLS
	CALL ZSKIP
	-2
	EXIT RNSUB

KALL,	JMS I	(GETLBL		/GET THE LABEL
/	TAD	(BRASUB		/AND THE OPCODE
SENDIT,	STL RAR
	TAD	SYMNUM
CMNCOD,	JMS I	ZCODE		/AND SEND IT OUT
	JMP I	ZNXTSTM
TRAP,	STA
	JMS RNSUB
	JMS	CKLET
	63
	CALL (GETLBL
	STA CLL RAL
	DCA I	(ONERCT
	STL RAR		/4000 HERE, 6000 LATER
	JMP SENDIT
CKLET,	0		/ROUTINE TO VERIFY A CHARACTER
	CALL	ZNXTCHR
	JMP I	ZNMLS
	CIA
	TAD I	CKLET
	SZA CLA
	JMP I	ZNMLS
	JMP I	CKLET

COMAND,	TAD SAVE
	DCA CHRPTR
CMCHK,	TAD	(CMLIST-2	/(NEE CMCHTKA) COMMAND LIST POINTER
	DCA	X0
	JMS I	ZNAME		/GET THE COMMAND
	JMP I	(IFTST
INK1,	ISZ X0
	CDF 10
	TAD I	X0		/CHECK AGAINST LIST
	SNA
	JMP	I ZNMLS		/NO KNOWN STMT
	CIA
	TAD	NAME1
	SNA CLA
	TAD NAME2
	CIA
	TAD I X0
	SZA CLA
	JMP	INK1		/NOT THIS COM.
	TAD I	X0
	CDF 00
	DCA	EXTMP1		/GET COMMAND HANDLER ADR
	TAD SAVE
	DCA CHRPTR
	CALL ZSKIP
	-4
	JMP I	EXTMP1		/GO THERE
ER25,	CALL ZERROR	/RELATIONAL IS N.G.
	ERR25
	PAGE

IARG,	0
	TAD (2		/AC MIGHT BE NON-ZERO
	DCA TYPE	/SET TYPE TO DEC (ALPHA)
	IAC
	DCA RIGHT
	CALL ZEXPR
	EXIT IARG
XARG,	0		/PARSE EXPR,BLKNAME
	JMS IARG
	CALL ZCOMA
	TAD Z10
	DCA TYPE
	CALL ZEXPR
	DCA TYPE
	EXIT XARG	/RETURN
WRYTE,	JMS I	(CKLET
	46
	IAC
WREAD,	TAD (READOP	/GET READ OR WRITE OP
	DCA WROPZ
	CALL ZLPAREN	/GET LEFT PAREN
	JMS XARG	/GET ARGS 1 AND 2
	CALL ZCOMA	/GET COMMA
	CALL ZEXPR	/GET ARG 3
	TAD WROPZ
CCLOSE,	CALL ZCODE	/OUTPUT
	CALL ZRPAREN	/GET RIGHT PAREN
	JMP I ZNXTSTM	/CONTINUE WITH NEXT STMNT

LPAREN,	0		/GET LEFT PARENTHESIS
	CALL ZNXTCHR
	JMP ER66	/BAD IF NOTHING
	TAD ZM11
	SNA CLA		/IS IT "("?
	EXIT LPAREN	/YES, RETURN
ER66,	CALL ZERROR	/NO
	ERR66		/MISSING LEFT PAREN
RPAREN,	0		/GET RIGHT PARENTHESIS
	CALL ZNXTCHR	/NOTHING IS BAD
	JMP ER67
	TAD ZM12
	SNA CLA		/IS IT ")"?
	EXIT RPAREN	/YES, RETURN
ER67,	CALL ZERROR	/NO, ERROR
	ERR67		/MISSING RIGHT PAREN
NOTRACE,TAD (6357-4244
	CALL (RNSUB
	TAD Z10		/NEW
	IFNZRO HERENT-HERETR-10<ERROR CATASTROPHIC>
TRACE,	TAD (HERETR
	CALL ZCODE
	JMS I	(CKLET
	46
	JMP I ZNXTSTM
WROPZ,	0

INIT,	CALL ZLPAREN	/GET LEFT PAREN
	JMS IARG
FORV,	CALL ZCOMA	/LOOK FOR COMMA
	CALL ZNAME	/GET DEVICE NAME
	JMP ER64	/NOTHING THERE.
	TAD (DEVTBL-1
	DCA NAME2		/SET UP FOR TBL SRCH
DEVLUP,	ISZ NAME2		/PASS OVER DEVICE CODE
	CDF 10
	TAD I NAME2	/GET TABLE ENTRY
	ISZ	NAME2
	SNA		/END OF TABLE?
	JMP ER64	/YES, DEVICE NOT FOUND
	TAD	NAME1
	AND	Z7700	/HIGH - ORDER CHAR ONLY
	SZA CLA		/IS THIS IT?
	JMP DEVLUP	/NO, KEEP LOOKING
	TAD I NAME2	/YES, GET CODE #
	CDF 0
	SNA		/ WAS IT F OR V?
	JMP	FORV	/YES - TRY AGAIN
	CIF 10
	CALL	(LPTTST
	JMP INIEND	/NO
	CALL ZCOMA	/LOOK FOR COMMA
	STA		/WANT ALPHA
	JMS IARG
	CALL (UNITRY
INIEND,	TAD (INITOP
	CALL ZCODE	/OUTPUT INIT OP
	TAD WROPZ
	JMP CCLOSE
ER64,	CALL ZERROR	/MISSING OR BAD DEVICE
	ERR64

DISPLAY,TAD (6357-5542
	CALL (RNSUB
	JMS I	(CKLET
	72
	CALL ZLPAREN	/CHECK FOR "("
	JMS IARG
	CALL ZCOMA	/GET DEC XCOORD
	JMS IARG	/GET DEC YCOORD
	CALL ZCOMA
	DCA TYPE	/BE UNBIASED
	CALL ZEXPR	/GET ARG3
	STA
	TAD TYPE
	CLL RAR
	SZA CLA
	JMP I (ER26
	TAD TYPE
	TAD (DISPOP-1
	JMP CCLOSE
FINIS,	CALL ZLPAREN	/GET LEFT PAREN
	JMS I	ZBACKUP		/PUT BACK (
	JMS IARG
	TAD	(FINIOP		/OUTPUT FINI OPCODE
	JMP I (CMNCOD
	PAGE

GOTO,	JMS I	ZNXTCHR		/LOOK FOR (
	JMP	LBLERR		/NOTHING LEFT MEANS ERROR
	TAD	ZM11
	SNA CLA
	JMP	COMPGT		/COMPUTED GO TO
	JMS I	ZBACKUP
	JMS	GETLBL		/GO GET LABEL
	TAD	(BRANCH
	TAD	SYMNUM
	JMS I	ZCODE		/OUTPUT BRANCH
	JMP I	ZNXTSTM		/GO GET NEXT STATEMENT
GETLBL,	0
	JMS I	ZNAME		/PICK UP LABEL NAME
	JMP	LBLERR		/MISSING LABLE
	TAD I (PROCSYM	/SEARCH FOR PROC SYMBOL
	JMS I	ZLOOKUP		/S.T. LOOKUP
	TAD I	OPRAND		/TEST TYPE
	CLL RAL
	SZA
	JMP	NNLABL		/THIS ISN'T FIRST REF.
	CLL CML RAR		/TYPE SET TO 4000
	RAR
	DCA I	OPRAND		/MEANS REFNCD, NOT DEFINED
	TAD OPRAND
	TAD Z3
	DCA OPRAND
	TAD LINENO
	DCA I OPRAND
GLRETN,	CDF 0
	JMP I	GETLBL
NNLABL,	AND	(4010		/IF DEFINED, MUST BE
	SZA CLA			/2000, OR 4
	JMP	GLRETN
	CALL ZERROR	/WRONG TYPE (NOT LABEL)
	ERR24
LBLERR,	ISZ CHRPTR
	JMS I	ZERROR
	ERR13

COMPGT,	TAD	X4		/SAVE STACK POSITION
	DCA	STKSAV
	TAD IFLG
	SZA CLA
	JMP I ZNMLS	/NOT ALLOWED IN IF
	DCA	GTTMP
CGTLUP,	JMS	GETLBL		/GET A LABEL
	TAD	SYMNUM
	CALL ZPUSH
	ISZ	GTTMP		/BUMP COUNT
	JMS I	ZNXTCHR		/LOOK AT DELIMITER
	JMP	I (ER67		/BAD COMPUTED GO TO
	TAD	ZM15		/IS IT A COMMA?
	SNA
	JMP	CGTLUP		/YES, GET NEXT LABEL
	TAD	Z3		/IS IT A ) ?
	SZA CLA
	JMP	I (ER67		/NO, ERROR
	CALL ZCOMA
	CALL (IARG
	TAD	(BCMPTD		/NOW A COMPUTED GO TO OP.
	JMS I	ZCODE
	TAD	GTTMP		/NOW THE COUNT
	JMS I	ZCODE
	TAD	GTTMP
	CIA
	DCA	GTTMP
	TAD STKSAV
	DCA X4
	TAD I X4
	TAD (BRANCH
	JMS I	ZCODE		/OUTPUT THIS LABEL
	ISZ	GTTMP
	JMP	.-4
	TAD STKSAV
	DCA X4
	JMP I	ZNXTSTM		/GO GET NEXT STMT
IFLG,	0

ACCEPT,	TAD (6357-6165
	CALL (RNSUB
	CALL ZLPAREN
	DCA RIGHT	/WANT LEFT SIDE
	STL RTL
	DCA TYPE	/WANT DEC
	CALL ZEXPR
	CALL ZCOMA
	CLA IAC
	DCA TYPE	/WANT ALPHA
	CALL ZEXPR
	TAD (ACPTOP
	JMP I (CCLOSE
STKSAV,		/SAVE PDL PTR
UNITRY,	0
	CALL ZNXTCHR
	JMP I (ER67
	TAD ZM15
	SZA CLA		/IS IT ","?
	JMP NOUN	/NO
	STL RTL
	DCA TYPE	/YES
	CALL ZEXPR	/COMPILE DECIMAL EXPRESSION
	TAD (TRYOP
	CALL ZCODE
	EXIT UNITRY

SUBB,	0
	TAD ZM12
	CALL ZCODE
	STL CLA RTL
	DCA TYPE	/SET TYPE TO 2
	EXIT SUBB
PREC,	10		/*
	05		/+
GTTMP,	0		/,
	05		/-
	20		/.
	10		//
	24		/# (UNARY)
	30		/# (BINARY)
NOUN,	CALL ZBACKUP
	EXIT UNITRY
	PAGE

GOPR8R,	JMS I	ZNXTCHR		/LOOK FOR OPERATOR
	JMP	NDEXPR		/END OF STMT
	TAD	M4
	SNA		/IS IT #?
	TAD	(16	/YES - CHANGE TO 1
	TAD	(4
	DCA	NEWOP		/SAVE CHAR
	TAD	NEWOP
	TAD	(-13
	SNA
	JMP	OPR8R	/* IS LEGAL
	CLL RAR
	AND	M4
	SNA CLA		/CHECK FOR +,-,/,#
	SNL		/IN ONE SWELL FOOP
	JMP	NOPR8R
OPR8R,	TAD	RIGHT		/CHECK SWITCH
	SNA CLA
	JMP I	(BADLFT		/OPERATOR ILLEGAL ON LEFT
	TAD	NEWOP
	TAD	(PREC-13
	DCA	PNEWOP		/GET NEW PRECEDENCE
CMPPRC,	JMS I	ZPOP		/GET OLD OPERATOR
	SNA
	JMP	PSHNEW+1	/IS ZERO, JUST PUSH NEW
	DCA	OLDOP
	TAD	OLDOP
	TAD	(PREC-13
	DCA	POLDOP		/GET OLD PREC
	TAD I	PNEWOP
	CIA
	TAD I	POLDOP		/COMPARE PREC
	SPA CLA
	JMP	PSHNEW		/IF P(OLD) < P(NEW), PUSH NEW
	TAD	OLDOP		/IF P(OLD) >= P(NEW), THEN ...
	CALL (SUBB
	JMP	CMPPRC		/AND DO NEW COMPARE
PSHNEW,	TAD	OLDOP		/REPLACE OLD
	JMS I	ZPUSH
	TAD	NEWOP		/PUSH NEW
	JMS I	ZPUSH
	JMP I	(GTOPND		/GET AN OPERAND
NOPR8R,	JMS I	ZBACKUP		/REPLACE ONE CHARACTER
NDEXPR,	JMS I	ZPOP		/OUTPUT ALL
	SNA			/REMAINING
	JMP EXPRET
	CALL (SUBB
	JMP	NDEXPR

EXPRET,	CALL ZPOP
	DCA NEWOP
	JMP I NEWOP
NEWOP,	0
OLDOP,	0
PNEWOP,	0
POLDOP,	0
/***IF OPERATOR IS #, SET TYPE TO 2 (DEC)

LOCK,	CALL ZLPAREN
	CALL (IARG		/PICK UP CHANNEL #
	TAD CHRPTR
	DCA SAVE
	JMS TCOMA		/MAY BE MORE ARGS
	CALL ZNAME
	JMP	LOKLIT		/NOT A NAME, TRY LITERAL
	CALL ZLOOKUP		/USE TYPE TO FIGURE OUT
	JMP	LOKTYP
LOKLIT,	JMS I	(LITERL
	JMP	LOKERR		/NEITHER LITERAL NOR VARIABLE?
	CDF SFLD
LOKTYP,	TAD I OPRAND
	CDF 00
	RTR
	SNL CLA
	JMP TRYL		/MUST BE LABEL
	TAD (PUSHOP
	TAD SYMNUM		/MAYBE SHOULD CHECK FOR DECIMAL
	CALL ZCODE		/THIS IS RECORD NUMBER
	TAD (LOKRC
	JMP I	(LOKXM		/OUTPUT RECORD LOCK OPERATOR
TRYL,	TAD SAVE		/MAYBE A LABEL?
	DCA CHRPTR
LOKEND,	TAD (LOKOP		/LET XMIT WORRY ABOUT IT
	JMP I (LOKXM

TCOMA,	0
	CALL ZNXTCHR		/LOOK FOR POSSIBLE COMA
	JMP TCOMER
	TAD ZM15
	SNA CLA
	JMP I TCOMA		/FOUND A COMA
	CALL ZBACKUP		/NO COMA, NO MORE ARGS
	JMP LOKEND
UNLOCK,	TAD (6357-4454		/SHARE SOME CODE
	CALL (RNSUB
	CALL ZLPAREN
	CALL (IARG		/BETTER BE CHANNEL #
	CALL ZNXTCHR
	JMP I (ER56		/BETTER BE MORE STATEMENT
	TAD ZM15		/COMMA MEANS ARG TO FOLLOW
	SZA CLA		/????
	JMP NOMORU
	CALL (IARG		/RECORD TO UNLOCK
	TAD (UNLREC
	JMP I	(CCLOSE		/SHARE SOME CODE
NOMORU,	CALL ZBACKUP
	TAD (UNLOK
	JMP I (CCLOSE
LOKERR,	CALL ZERROR
	ERR2
TCOMER,	CALL ZERROR
	ERR67
PRCOVL=.&7600+200		/DETERMINES LENGTH OF PROC OVERLAY
	PAGE

/ VARIOUS FIELD ONE GOODIES
PRCDIV,	6163
	6044
	4645
	6663
	4601
CMLIST,	4657;4501;EENDY
	5247;0101;IF
	5257;5265;INIT
	7156;5265;XMIT
	4752;5752;FINIS
	6465;4263;STAR
	4760;6356;FORMS
	6346;4245;WREAD
	7063;5265;WRYTE

	4552;6461;DISPLAY
	4244;4446;ACCEPT
	5257;4463;INKR
	5560;4454;LOCK
	6657;5560;UNLOCK
CML2,	5060;6560;GOTO
	6346;6566;RETURN
	6465;6061;STOP
	4442;5555;KALL
	6563;4244;TRACE
	5760;6563;NOTRACE
	6057;4663;TRAP
	6346;5546;RELEAS
	0
	/ERROR DETECTION SECTION:
	IFNZRO BLOCK-3400	<_ERROR - SEE "BLKJMX">
	IFNZRO	PROCST-2000	<_ERROR - SEE "PATCH3">

/ SOME TEXT FOR THE END OVERLAY
PRGCOR,	PRGCOR-JOBCOR+1	/00 K CORE + 0000 LOCS REQUIRED FOR PROGRAM.
	2121
	0154
	0144
	6063
	4601
	1401
PRGLCS,	2121
	2121
	0155
	6044
	6401
	6346
	6266
	5263
	4645
	0147
	6063
	0161
	6360
	5063
	4256
	1700
JOBCOR,	JOBCOR-NJOBS+1	/00 K CORE + 0000 LOCS REQUIRED PER TERMINAL
	0121
	0154
	0144
	6063
	4601
	1401
JBCOR,	0
	0
	0155
	6044
	6401
	6346
	6266
	5263
	4645
	0161
	4663
	0165
	4663
	5652
	5742
	5517
NJOBS,	NJOBS-OPTMSG+1	/ENOUGH ROOM FOR 00 TERMINALS.
	4657
	6066
	5051
	0163
	6060
	5601
	4760
	6301
NTERM,	2121
	0165
	4663
	5652
	5742
	5564
	1700

OPTMSG,	-10	/COMPILED WITH /O
	4460;5661;5255
	4645;0170;5265
	5101;2060
TYPE3,	-3;SYMTAB;0;0
STLENT,	-24	/XXX SYMBOLS
	101;101;164
	7256;4360;5564
	1701
	0101
	0101
	0101
ERTXT,	101;146;6363;6063
S,	6401;4546
	6546;4465;4645
	1700

MD,	6346;4546;4700
AL,	4255;6151;4201
DE,	4546;4456;4255
LA,	5542;4346;5501
UN,	6657;4546;4701
RE,	6346;4460;6345
CP,	4444;6100
RELLST,	-5065	/GT - SZL SNA CLA
	-5546	/LE - SNL SZA CLA
	-5746	/NE - SNA CLA
	-4662	/EQ - SZA CLA
	-5046	/GE - SZL CLA
	-5565	/LT - SNL CLA
	-5	/WORD COUNT FOR XLVTXT
XLVTXT,	5760	/NO ERRORS
	0146
	6363
	6063
	6400

	*6400
MESOVO=.
	NOPUNCH
	*6400
	ENPUNCH
MESOVF=.
/ERROR MESSAGES MUST BE IN UPPER HALF OF FIELD
/ SEE CDOIOC FOR WHY
ERR2,	ERR2-ERR3	/MISSING OPERAND
	5652;6464;5257
	5001;6061;4663
	4257;4500
ERR3,	ERR3-ERR4	/SUBSCRIPT ERROR
	6466;4364;4463
	5261;6501;4663
	6360;6300
ERR4,	ERR4-ERR5	/EXPRESSION NOT ALLOWED
	4671;6163;4664
	6452;6057;157
	6065;142;5555
	6070;4645;0
ERR5,	ERR5-ERR6	/UNDEFINED NAME
	6657;4546;4752
	5746;4501;5742
	5646;0
ERR6,	ERR6-ERR10	/WRONG DATA TYPE
	7063;6057;5001
	4542;6542;165
	7261;4600
ERR10,	ERR10-ERR11	/MISSING QUOTE
	5652;6464;5257
	5001;6266;6065
	4600
ERR11,	ERR11-ERR12	/ILLEGAL STMNT
	5255;5546;5042
	5501;6465;5657
	6500
ERR12,	ERR12-ERR13	/NAME PREVIOUSLY DEFINED
	5742;5646;161
	6346;6752;6066
	6455;7201;4546
	4752;5746;4500
ERR13,	ERR13-ERR14	/EXPECTED LABEL IS MISSING
	4671;6146;4465
	4645;155;4243
	4655;152;6401
	5652;6464;5257
	5000
ERR14,	ERR14-ERR15	/EXTRA CHARS ARE AT STMNT END
	4671;6563;4201
	4451;4263;6401
	4265;164;6556
	5765;146;5745
	0
ERR15,	ERR15-ERR16	/FIELD TOO LARGE OR 0
	4752;4655;4501
	6560;6001;5542
	6350;4601;6063
	121;0
ERR16,	ERR16-ERR17	/ILLEGAL OPERATOR
	5255;5546;5042
	5501;6061;4663
	4265;6063;0
ERR17,	ERR17-ERR20	/SUBSCRIPT NOT DECIMAL
	6466;4364;4463
	5261;6501;5760
	6501;4546;4452
	5642;5500
ERR20,	ERR20-ERR22	/RECORD TOO BIG
	6346;4460;6345
	165;6060;143
	5250;0
ERR22,	ERR22-ERR23	/STMNT TOO COMPLEX
	6465;5657;6501
	6560;6001;4460
	5661;5546;7100
ERR23,	ERR23-ERR24	/TOO MANY SYMBOLS!
	6560;6001;5642
	5772;164;7256
	4360;5564;200
ERR24,	ERR24-ERR25	/NOT LABEL
	5760;6501;5542
	4346;5500
ERR25,	ERR25-ERR26	/BAD RELATIONAL
	4342;4501;6346
	5542;6552;6057
	4255;0
ERR26,	ERR26-ERR43	/LABEL NOT ALLOWED
	5542;4346;5501
	5760;6501;4255
	5560;7046;4500
ERR43,	ERR43-ERR45	/BAD DECIMAL VALUE
	4342;4501;4546
	4452;5642;5501
	6742;5566;4600
ERR45,	ERR45-ERR46	/MISSING OR BAD OPTION
	5652;6464;5257
	5001;6063;143
	4245;160;6165
	5260;5700
ERR46,	ERR46-ERR47	/DATA INITIALIZATION MISSING
	4542;6542;152
	5752;6552;4255
	5273;4265;5260
	5701;5652;6464
	5257;5000
ERR47,	ERR47-ERR50	/BAD ALPHA VALUE
	4342;4501;4255
	6151;4201;6742
	5566;4600
ERR50,	ERR50-ERR51	/TOO MANY ITEMS
	6560;6001;5642
	5772;152;6546
	5664;0
ERR51,	ERR51-ERR52	/INITIAL VALUE WRONG SIZE
	5257;5265;5242
	5501;6742;5566
	4601;7063;6057
	5001;6452;7346
	0
ERR52,	ERR52-ERR56	/NOT A OR D
	5760;6501;4201
	6063;145;0
ERR56,	ERR56-ERR61	/COMMA MISSING
	4460;5656;4201
	5652;6464;5257
	5000
ERR61,	ERR61-ERR63	/PROGRAM TOO BIG
	6163;6050;6342
	5601;6560;6001
	4352;5000
ERR63,	ERR63-ERR64	/TOO MUCH DATA
	6560;6001;5666
	4451;145;4265
	4200
ERR64,	ERR64-ERR65	/MISSING OR BAD DEVICE
	5652;6464;5257
	5001;6063;143
	4245;145;4667
	5244;4600
ERR65,	ERR65-ERR66	/MISSING RELATIONAL
	5652;6464;5257
	5001;6346;5542
	6552;6057;4255
	0
ERR66,	ERR66-ERR67	/MISSING OPEN PAREN
	5652;6464;5257
	5001;6061;4657
	161;4263;4657
	0
ERR67,	ERR67-ERR70	/MISSING CLOSE PAREN
	5652;6464;5257
	5001;4455;6064
	4601;6142;6346
	5700
ERR70,	ERR70-ERR71	/BAD PROC #
	4342;4501;6163
	6044;104;0
ERR71,	ERR71-ERR100	/CCP ERROR
	4444;6101;4663
	6360;6300
ERR100,	ERR100-DEVTBL	/TOO MANY LITERALS
	6560;6001;5642
	5772;0155;5265
	4663;4255;6400
/	! INDICATES COMPILER ABORT.

/DEVICE TABLE USED BY INIT
DEVTBL,	-5200;2000	/IN
	-6000;4000	/OUT
	-6600;6000	/UPDATE
	-5400;100	/KBD
	-6500;101	/TTY
	-4400;102	/CDR
	-6100;103	/PUNCH
	-6300;104	/RDR
	-5500;105	/LPT
	-4700;0		/F
	-6700;0		/V
	-6400;1777	/SYS
	0		/TABLE END

HEADING,HEADING-PAGNUM
	5666;5565;5216;4552
	4360;5501;101
	167
	122;1722;2601		/*** " 1.15 " ***
	0101
DAY,	101;166;5745
	1630;4645;101
WKDAY,	0101;0101
	101;101
CMPLTN,	4460
	5661;5255;4265
	5260;5701
LSTNG,	5552
	6465;5257;5001
	101;101
	161;4250;4601
PAGNUM,	2121
	MONTH1=DAY+1
	MONTH2=DAY+2
	YEAR=DAY+4
HEAD2,	6465;6063;4250
	4601;5642;6101

SUBHDG,	SUBHDG-EOMESGS
	101;101;101
	101;101;4542
	6542;145;5267
	5264;5260;5701
	101;0
	ZBLOCK	33		/PADDING FOR THE USER HEADING
EOMESGS=.
MESOVL=.&7600+200

STITLE,	-31
	401;101;101
	101;5742;5646
	101;101;101
	6572;6146;101
	101;101;145
	5256;101;101
	6452;7346;101
	101;6063;5250
	5257
NOCORE,	-10	/NO ROOM IN CORE
	5760;0163;6060
	5601;5257;0144
	6063;4600

////////////////////////////
/			   /
/	END OF MCOMP       /
/			   /
////////////////////////////
	$