Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-10 - 43,50517/rpgiig.mac
There is 1 other file named rpgiig.mac in the archive. Click here to see a list.
TITLE	RPGIIG FOR RPGII 1
SUBTTL	PHASE G	- ASSEMBLY	AL BLACKINGTON/CAM/SEB/BOB CURRIER


;CONVERTED TO RPGII VERSION, AUGUST 11, 1975 	02:48:35


;SOME OF THIS IS STILL
;COPYRIGHT 1974, DIGITAL EQUIPMENT CORP., MAYNARD, MA.
;BUT A LOT HAS BEEN MODIFIED BY BOB CURRIER

TWOSEG
RELOC	400000

	INTERNAL CLRDAT,PUTDAT,PDATI

	EXTERNAL SETASY,GETASY,PUTBIN,KILL
	EXTERNAL PUTLST,LCRLF,HDROUT,LSTMES,KILLF,LNKSET
	EXTERNAL RESTRT,DEVDED
	EXTERNAL BLKTYP
IFN	CREF,<
	EXTERNAL PSORT,RELES,RETRN,MERGE >

RPGIIG:	SETFAZ	G;
	SKIPN	NAMNXT		;IF NO NAMTAB,
	SETOM	PRODSW		;  PRETEND '/P' TYPED
	SETZM	GAERAS		;CLEAR ERROR COUNTER


	IFE DEBUG, <TSWF FFATAL;
		JRST	NDASY0>

	SKIPN	BINDEV		;DO WE HAVE TO ASSEMBLE?
	TSWF	FOBJEC;
	JRST	RPGIGA		;YES
	JRST	NDASY0		;NO--QUIT

RPGIGA:	MOVSI	TE,(ASCIZ "A")
	MOVEM	TE,HDRPAG
	SETZM	SUBPAG
	SETZM	PAGCNT

	TSWT	FOBJEC		;ANY OBJECT LISTING?
	SWON	FNOLST		;NO--TURN ON "NO LISTING AT ALL"
	PUSHJ	PP,INITAL	;INITIALIZE THE PHASE
	PUSHJ	PP,SETASY	;INITIALIZE THE FILE
	JRST	GET
;PICK UP NEXT ASYFIL

NXTASY:	CLOSE	ASY,		;CLOSE THAT ASYFIL
	MOVEI	TE,0		;DELETE
	RENAME	ASY,TE		;  THE ASYFIL,
	JFCL			;  IGNORING ANY TROUBLE

NXTAS0:	PUSHJ	PP,CLRDAT	;CLEAN OUT GRPDAT
	HRRZ	TA,ASYFIL	;WAS THAT AS3FIL?
	CAIN	TA,(SIXBIT "AS3")
	JRST	ENDASY		;YES--ALL DONE

	AOS	ASYFIL		;NO--SET UP NEXT

	CAIE	TA,(SIXBIT "AS1")	;WAS THAT THE DATA SEGMENT?
	JRST	NXTAS1		;NO


;NEXT INPUT FILE IS FOR THE CONTROL LEVEL CALC SECTIONS

	SWOFF	FASDAT;		;TURN OFF "THIS IS DATA DIVISION"

	PUSHJ	PP,STARTI

	MOVE	PC,RESDNT	;RESET CURRENT LOCATION COUNTER
	MOVEM	PC,DATGRP+2
	JRST	NXTAS3


;NEXT INPUT FILE IS FOR THE DETAIL CALC SECTIONS

NXTAS1:	PUSHJ	PP,EXTOUT	;WRITE OUT ANY DUMMIES FOR EXTERNAL REFERENCES
	MOVE	PC,NONRES

NXTAS3:	MOVEM	PC,CURREL

NXTAS2:	PUSHJ	PP,SETASY
;PICK UP NEXT ITEM IN ASYFIL
GET:	PUSHJ	PP,GETASY	;GET NEXT DATUM
	JUMPE	CH,NXTASY	;JUMP IF FILE FINISHED
	MOVE	W1,CH

GET0:	JUMPL	CH,NOTOPR	;IS IT AN INSTRUCTION?

	MOVE	TB,W1		;SET UP LH OF "TB"

	LDB	TE,[POINT 3,W1,20];PICK UP ADDRESS TYPE
	CAIE	TE,6		;CONSTANT OR
	CAIN	TE,7		;  MISCELLANEOUS?
	TLO	W1,ASINC	;YES--SET "INCREMENT FOLLOWS"

	TLNN	W1,ASINC	;ANY INCREMENT?
	TDCA	CH,CH		;NO--USE ZERO
	PUSHJ	PP,GETASY	;YES--GET IT
	HRRZ	W2,CH

GET1:	PUSHJ	PP,GETOPR
	TSWT	FNOLST		;ANY LISTING?
	PUSHJ	PP,LSTOPR	;YES--LIST IT

	AOJA	PC,GET			;LOOP

;ITEM WAS NOT AN INSTRUCTION

NOTOPR:	SWOFF	FGDEC;
	LDB	TA,[POINT 3,W1,2];GET CODE
	JRST	@.+1-4(TA)
	EXP	BYTER
	EXP	XWDER
	EXP	CONST
	EXP	MISC
;ITEM IS A BYTE POINTER

BYTER:	PUSHJ	PP,GETASY
	HRRZ	W2,CH
	MOVE	TB,CH

	PUSHJ	PP,GETADR

	PUSHJ	PP,PUTDAT

	TSWT	FNOLST!FASDAT	;ANY LISTING?
	PUSHJ	PP,LSTBYT		;YES--LIST THE BYTE POINTER

	AOJA	PC,GET			;BACK FOR NEXT
;ITEM IS AN XWD

XWDER:	HRRZ	CT,W1		;GRAB ITEM COUNT

XWDER1:	PUSHJ	PP,GETASY	;GRAB LH WORD FROM ASYFIL
	MOVE	W1,CH
	HLRZ	W2,CH

	PUSHJ	PP,GETADR	;RESOLVE ADDRESS

	MOVSS	TB		;PUT IT IN LEFT HALF
	LSH	TA,1		;SHIFT RELOCATION
	PUSH	PP,W1		;SAVE THE WORD
	PUSH	PP,TA		;SAVE RELOCATION

	PUSHJ	PP,GETASY	;GRAB RH WORD FROM ASYFIL
	MOVE	W1,CH
	HLRZ	W2,CH

	PUSHJ	PP,GETADR	;RESOLVE ADDRESS

	POP	PP,TC		;GET LH RELOCATION
	OR	TA,TC		;COMBINE WITH RH
	PUSHJ	PP,PUTDAT	;WRITE OUT WORD

	EXCH	W1,(PP)
	POP	PP,TC
	TSWT	FNOLST!FASDAT	;ANY LISTING?
	PUSHJ	PP,LSTXWD	;YES--LIST IT

	ADDI	PC,1		;KICK UP LOCATION COUNTER

	SOJG	CT,XWDER1	;LOOP IF MORE XWD'S

	JRST	GET		;NO--GO AFTER NEXT ITEM
;ITEM IS A CONSTANT

CONST:	HRRZ	CT,W1
	TLNN	W1,ASCON
	JRST	BADCON

	TLNE	W1,ASCSIX
	JRST	CONSIX
	TLNE	W1,ASCASC
	JRST	CONASC
	TLNE	W1,ASCD1
	MOVEI	OP,0
	TLNE	W1,ASCD2
	MOVEI	OP,1
	TLNE	W1,ASCFLT
	MOVEI	OP,2
	TLNE	W1,ASCOCT
	MOVEI	OP,3

CONST1:	PUSHJ	PP,GETASY
	TLNN	W1,ASCFLT	;FLOATING POINT?
	SKIPA	TB,CH		;NO--TAKE IT AS IS
	PUSHJ	PP,FLTCON	;YES--CONSTRUCT CONSTANT

	MOVEI	TA,0
	PUSHJ	PP,PUTDAT

IFE DEBUG,<
	TSWT	FASDAT; >	;DON'T LIST IF DATA DIVISION
	TSWF	FNOLST;
	JRST	CONST2

	PUSHJ	PP,LSTCOD
	PUSHJ	PP,@CONTAB(OP)
	PUSHJ	PP,LCRLF

CONST2:	ADDI	PC,1

	SOJG	CT,CONST1
	JRST	GET


BADCON:	TTCALL	3,[ASCIZ "BAD CONSTANT TYPE IN ASYFIL
"]
	JRST	KILLF
;ITEM IS A CONSTANT  (CONT'D).

;IT IS SIXBIT

CONSIX:	MOVE	TC,CT

CONSX1:	CAIG	TC,^D12
	JRST	CONSX2

	MOVEI	TC,^D12
	PUSHJ	PP,LSTSIX
	MOVNI	TC,^D12
	ADDB	TC,CT
	JRST	CONSX1

CONSX2:	PUSHJ	PP,LSTSIX
	JRST	GET


;IT IS ASCII

CONASC:	MOVE	TC,CT

CONAS1:	CAIG	TC,^D14
	JRST	CONAS2

	MOVEI	TC,^D14
	PUSHJ	PP,LSTASC
	MOVNI	TC,^D14
	ADDB	TC,CT
	JRST	CONAS1

CONAS2:	PUSHJ	PP,LSTASC
	JRST	GET
;ITEM IS MISCELLANEOUS

MISC:	TLNE	W1,ASPARN	;PARAGRAPH OR SECTION NAME?
	JRST	MISPRO		;YES
	TLNE	W1,ASTAGN	;NO--SPECIAL TAG?
	JRST	MISTAG		;YES
	TLNE	W1,ASREL	;NO--RELOC?
	JRST	MISREL		;YES
	TLNE	W1,ASENTN	;NO, ENTRY?
	JRST	MISPRO		;YES

	TTCALL	3,[ASCIZ "BAD MISC. OPERATOR
"]
	JRST	KILL


;ITEM IS A PROCEDURE NAME

MISPRO:	TSWF	FNOLST;		;ANY LISTING?
	JRST	MISP1		;NO

	MOVE	TA,TAGOUT	;ANY TAGS BEING PRINTED?
	JUMPLE	TA,MISP1
	PUSHJ	PP,LCRLF	;YES--PUT OUT <C.R.>,<L.F.>
	SWON	FASPAR;
	SETOM	TAGOUT

MISP1:	MOVE	DT,W1		;GET PRODAT ENTRY
	ANDI	DT,77777
	TLNE	W1,ASENTN	;ENTRY?
	JRST	MISENT		;YES
	ADD	DT,PROLOC
	JRST	MISP5		;NO
;ITEM IS AN ENTRY POINT

MISENT:	ADD	DT,EXTLOC	;GET ABS EXTAB ADDR
	MOVE	TD,PC		;PUT PC VALUE IN EXTAB ENTRY
	HRRM	TD,1(DT)
	TSWF	FNOLST		;LISTING?
	JRST	MISEN1		;NO

	PUSHJ	PP,HDROUT	;NEW PAGE
	PUSHJ	PP,TABS3	;3 TABS
	MOVE	TE,[POINT 7,[ASCIZ "ENTRY	"]]
	PUSHJ	PP,LSTMES
	PUSHJ	PP,LSTNAM
	PUSHJ	PP,LCRLF	;2 CRLF
	PUSHJ	PP,LCRLF
	PUSHJ	PP,TABS3
	PUSHJ	PP,LSTNAM	;"ENTRY-NAME:"
	MOVEI	CH,":"
	PUSHJ	PP,PUTLST
	PUSHJ	PP,LCRLF
	PUSHJ	PP,LCRLF

MISEN1:	JRST	GET

TABS3:	MOVEI	CH,11		;PUT OUT 3 TABS
	PUSHJ	PP,PUTLST
	PUSHJ	PP,PUTLST
	PUSHJ	PP,PUTLST
	POPJ	PP,
;ITEM IS A PROCEDURE NAME  (CONT'D).

;ITEM IS A PARAGRAPH NAME

MISP5:	TSWF	FNOLST		;ANY LISTING?
	  JRST	MISP6		;NO
	TSWTS	FASPAR;		;ANY NAME OUT FOR THIS LINE?
	  PUSHJ	PP,LCRLF	;NO--PUT OUT <C.R.>,<L.F.>
	PUSHJ	PP,TABS3
	PUSHJ	PP,LSTNAM	;PUT OUT A PARAGRAPH-NAME
	MOVEI	CH,":"
	PUSHJ	PP,PUTLST
	PUSHJ	PP,LCRLF


;INSURE THAT THE PROCEDURE-NAME JUST SEEN BELONGS AT THIS ADDRESS

MISP6:	HLRZ	TA,0(DT)		; [261] get NAMTAB offset
	ANDI	TA,LMASKB		; [261] get the naughty bits
	JUMPE	TA,MISP6A		; [261] ignore if zero entry
	ADD	TA,NAMLOC		; [261] offset it
	MOVE	TC,1(TA)		; [261] get the sixbit name
	PUSHJ	PP,RADX50		; [261] convert to RAD50
	TLO	CH,040000		; [261] mark as relocatable
	MOVE	TA,PC			; [261] value = .
	PUSHJ	PP,PUTSYM		; [261] output the symbol and value

MISP6A:	LDB	TE,PTSEGN
	SKIPN	TE		;RESIDENT SEGMENT?
	 SKIPA	TD,RESDNT	;YES
	  MOVE	TD,NONRES	;NO
	ADD	TD,(DT)		;RELOCATE THE ADDRESS
	CAIN	PC,(TD)		;OK?
	  JRST	GET		;YES--RETURN
	MOVE	TE,[POINT 7,[ASCIZ "

				******** PHASE ERROR ********

"]]
	PUSHJ	PP,LSTMES
	MOVNI	TE,4
	ADDB	TE,PAGCNT
	SKIPG	TE
	PUSHJ	PP,HDROUT
	AOS	GAERAS
	JRST	GET
;ITEM IS MISCELLANEOUS (CONT'D)
;SPECIAL TAG

MISTAG:	MOVE	TC,W1			; [261] get value of tag
	SETZ	TA,			; [261] start fresh

MTAG0:	IDIVI	TC,^D10			; [261] shift
	ADDI	TB,20			; [261] convert to sixbit character
	LSHC	TB,-6			; [261] make room for next one
	JUMPN	TC,MTAG0		; [261] loop until done
	LSH	TA,-6			; [261] shift one more time to make room for
	TLO	TA,(<'%'>B5)		; [261] the percent sign
	MOVE	TC,TA			; [261] get into proper AC
	PUSHJ	PP,RADX50		; [261] convert to RAD50
	TLO	CH,040000		; [261] is relocatable
	MOVE	TA,PC			; [261] get the symbol value
	PUSHJ	PP,PUTSYM		; [261] output the symbol
	TSWF	FNOLST;			;ANY LISTING?
	  JRST	GET			;NO--FORGET IT
	AOSE	TA,TAGOUT		;ALREADY ONE FOR THIS LINE?
	  JRST	MSTAG2			;YES
	MOVEM	W1,SAVTAG		;NO--SAVE THIS ONE
	JRST	GET

MSTAG2:	CAIE	TA,1			;ANY TAG BEING SAVED?
	  JRST	MSTAG3			;NO
	TSWT	FASPAR;			;ANY PARAGRAPH-NAME FOR THIS LINE?
	  PUSHJ	PP,LCRLF		;NO--PUT OUT <C.R.>
	PUSHJ	PP,TABS3
	MOVE	TC,SAVTAG		;PRINT THE TAG
	PUSHJ	PP,MSTAG4

MSTAG3:	MOVEI	CH," "			;PRINT A SPACE
	PUSHJ	PP,PUTLST
	MOVE	TC,W1			;PRINT THIS TAG
	PUSHJ	PP,MSTAG4
	JRST	GET

MSTAG4:	MOVEI	CH,"%"
	PUSHJ	PP,PUTLST
	ANDI	TC,77777
	PUSHJ	PP,LSINC5
	MOVEI	CH,":"
	PUSHJ	PP,PUTLST
	MOVE	TE,TAGOUT		;IS PRINT-LINE FULL OF TAGS?
	CAIE	TE,^D11
	  POPJ	PP,
	SWON	FASPAR;			;YES--SET "PARAGRAPH NAME PRINTED"
	SETOM	TAGOUT			;SET "NO TAGS"
	JRST	LCRLF
;ITEM IS MISCELLANEOUS (CONT'D)
;
;RELOC
;

MISREL:	TLNN	W1,1		;ANY INCREMENT?
	 TDCA	CH,CH		;NO--USE ZERO
	  PUSHJ	PP,GETASY	;YES--GET IT
	HRRZ	W2,CH
	PUSHJ	PP,GETADR	;ASSEMBLE ADDRESS INTO RH OF TB
	TSWF	FASSEG		;OVERLAY SEGMENT?
	 CAIN	PC,(TB)		;YES--IS PC ACTUALLY BEING CHANGED?
	  JRST	MISRL5		;YES--TROUBLE
	MOVEI	TE,[POINT 7,[ASCIZ "
				****** IMPROPER RELOC ******

"]]
	PUSHJ	PP,LSTMES
	MOVNI	TE,3
	ADDM	TE,PAGCNT
	AOS	GAERAS
	JRST	GET

MISRL5:	TSWF	FASSEG		;IS THIS AN OVERLAY SEGMENT?
	  JRST	MISRL6		;YES
	PUSHJ	PP,CLRDAT	;NO--CLEAR DATGRP
	HRRZ	PC,TB
	MOVEM	PC,DATGRP+2

MISRL6:	TSWT	FNOLST;		; [261] any listing?
	  PUSHJ	PP,LCRLF	; [261] yes -
	HRRZS	W1		; GET USEFUL BITS
	CAIE	W1,7B20		;WAS THAT A MISCELLANEOUS REFERENCE?
	  JRST	GET		;NO--RETURN
	CAIN	W2,1B20		;OTF BASE?
	  JRST	MISR10		; YES 
	CAIN	W2,2B20		; NO - OCHBAS?
	  JRST	MISR11		; YES -
	CAIN	W2,4B20		; NO - ICHBAS?
	  JRST	MISR12		; YES -
	CAIN	W2,7B20		; [356] no - DATBAS?
	  JRST	MISR14		; YES -
	CAIN	W2,3B20		;NO--LITERAL BASE?
	  JRST	MISRL8		;YES
	JRST	GET		;NO--RETURN
;RELOC (CONT'D)

;SPECIAL RELOC--PRINT OUT A TAG

MISRL8:	TSWF	FNOLST;			; [261] any listing?
	  JRST	MSRL8A			; [261] no -
	MOVEI	CH,HDROUT
	MOVE	TA,PAGCNT
	CAIL	TA,^D30
	  MOVEI	CH,LCRLF
	PUSHJ	PP,(CH)

MSRL8A:	MOVE	TA,[SIXBIT "%LIT"]	;PRINT OUT "%LIT:" AS A TAG


MISRL9:	TSWF	FNOLST;			; [261] any listing?
	  JRST	MSRL9A			; [261] no -
	PUSHJ	PP,TABS3
	PUSHJ	PP,SIXOUT

MSRL9A:	MOVE	TC,TA			; [261] get symbol into proper AC
	PUSHJ	PP,RADX50		; [261] convert to RAD50
	TLO	CH,040000		; [261] is relocatable
	MOVE	TA,PC			; [261] get value
	PUSHJ	PP,PUTSYM		; [261] output the symbol
	TSWF	FNOLST;			; [261] any listing?
	  JRST	GET			; [261] no - exit
	MOVEI	CH,":"
	PUSHJ	PP,PUTLST
	SWON	FASPAR;
	PUSHJ	PP,LCRLF
	JRST	GET

MISR10:	SKIPA	TA,[SIXBIT "%OTF"]

MISR11:	MOVE	TA,[SIXBIT "%OCH"]
	SWOFF	FASDAT;
	JRST	MISRL9

MISR12:	SKIPA	TA,[SIXBIT "%ICH"]

MISR14:	MOVE	TA,[SIXBIT "%DAT"]
	SWOFF	FASDAT;
	JRST	MISRL9

;END OF ASSEMBLY

ENDASY:	MOVE	CH,[RADIX50 04,%TEMP]	; [261] get symbol name
	MOVE	TA,TEMBAS		; [261] get value
	PUSHJ	PP,PUTSYM		; [261] output it
	MOVE	CH,[RADIX50 04,%ARR]	; [261] get another symbol
	MOVE	TA,ARRBAS		; [261] get another value
	MOVE	TB,ARRLOC		; [261] get start of ARRTAB
	CAME	TB,ARRNXT		; [261] same as the end?
	  PUSHJ	PP,PUTSYM		; [261] no - output symbol
	PUSHJ	PP,CLRDAT	;CLEAR OUT DATGRP

NDASY2:	PUSHJ	PP,EXTOUT	;WRITE OUT EXTERNAL REQUESTS

	PUSHJ	PP,ENDBLK	;PUT OUT END BLOCK

NDASY3:	TSWF	FNOLST		;ANY LISTING?
	JRST	NDASY0		;NO

	MOVE	TE,[POINT 7,[ASCIZ "
				END"]]
	PUSHJ	PP,LSTMES
	MOVE	TE,[POINT 7,[ASCIZ "	START."]]
	PUSHJ	PP,LSTMES	;YES, LIST "END START."
	PUSHJ	PP,LCRLF
	PUSHJ	PP,PBREAK	;PRINT OUT PROGRAM BREAK

NDASY0:	SKIPE	LSTDEV
	SWOFF	FNOLST;
	PUSHJ	PP,CNTOUT
	SKIPLE	GAERAS		;ANY ASSEMBLY ERRORS?
	PUSHJ	PP,NDASY5

NDASY4:
IFE DEBUG,<
	TSWF	FFATAL		;IN STANDARD VERSION, IF FATAL
	CLOSE	BIN,$CLS40	;  ERROR, DISCARD NEW REL, KEEP OLD
	>
	RELEASE	BIN,		;THROW AWAY BIN DEVICE
IFN CREF,<
	SKIPE	CREFSW		;IF '/C',
	PUSHJ	PP,CREFL >	;  PUT OUT CREF LISTING
	IFN DEBUG,<
	PUSHJ	PP,SUMARY>

	MOVEI	CH,14
	PUSHJ	PP,PUTLST

	RELEASE LST,

;DELETE ALL SCRATCH FILES AND RELEASE I/O CHANNELS, THEN RESTART COMPILATION

	MOVE	I0,[RENAME FSC,I1]
	MOVSI	TA,(CLOSE FSC,)
	MOVSI	TB,(RELEASE FSC,)

NDASY1:	CAME	I0,[RENAME LIT,I1]
	JRST	NDAS1A
	SKIPGE	LITBLK
	JRST	NDAS1B
NDAS1A:	CAME	I0,[RENAME CRF,I1]
	JRST	NDAS1C
	SKIPN	CREFSW
	JRST	NDAS1B
NDAS1C:	SETZB	I1,I2
	SETZB	I3,I4
	XCT	TA
	XCT	I0
	JFCL			;IGNORE ERRORS
	XCT	TB
NDAS1B:	CAMN	I0,[RENAME LSC,I1]
	JRST	RESTRT

	ADD	I0,[1B12]
	ADD	TA,[1B12]
	ADD	TB,[1B12]

	JRST	NDASY1


NDASY5:	PUSHJ	PP,PUTQRY
	MOVE	TE,GAERAS
	MOVE	TA,[POINT 7,[ASCIZ " Assembly Error"]]
	JRST	CNTO1

;TYPE OUT "?" AND BUMP JOBERR

PUTQRY:	MOVE	TE,[POINT 7,[ASCIZ "
?"]]
	TSWF	FLTTY		;LISTING ON TTY?
	JRST	PUTQR2		;YES
	TTCALL	3,(TE)		;NO


PUTQR1:	AOS	TD,.JBERR##
	TRNN	TD,-1
	SOS	.JBERR
	POPJ	PP,

PUTQR2:	PUSHJ	PP,LSTMES
	SOS	PAGCNT
	JRST	PUTQR1
;PUT OUT MESSAGE FOR NUMBER OF ERRORS

CNTOUT:	PUSHJ	PP,LCRLF
	PUSHJ	PP,LCRLF
	SKIPE	COUNTF		;ANY FATAL ERRORS?
	PUSHJ	PP,PUTQRY	;YES--TYPE "?"

	MOVE	TD,COUNTW	;ANY ERRORS
	ADD	TD,COUNTF	;  AT ALL?
	JUMPE	TD,CNTO2

	MOVE	TE,COUNTF
	MOVE	TA,[POINT 7,[ASCIZ " Fatal Error"]]
	PUSHJ	PP,CNTO3
	MOVE	TA,[POINT 7,[ASCIZ ", "]]
	PUSHJ	PP,CNTO6
	MOVE	TE,COUNTW
	MOVE	TA,[POINT 7,[ASCIZ " Warning"]]
CNTO1:	PUSHJ	PP,CNTO3
	TSWT	FLTTY;
	TTCALL	3,[ASCIZ "
"]
	JRST	LCRLF

CNTO2:	MOVE	TE,[POINT 7,[ASCIZ "No Errors Detected"]]
	PUSHJ	PP,LSTMES
	JRST	LCRLF

;NUMBER OF ERRORS IS IN TE, TA HAS BYTE-POINTER TO TEXT

CNTO3:	JUMPN	TE,CNTO4	;IS NUMBER ZERO?
	MOVEI	CH,"N"		;YES--
	PUSHJ	PP,CNTO10	;  TYPE
	MOVEI	CH,"o"		;  AND PRINT
	PUSHJ	PP,CNTO10	;  'NO'
	SKIPA

CNTO4:	PUSHJ	PP,CNTO9
	PUSHJ	PP,CNTO6
	CAIN	TE,1
CNTO5:	POPJ	PP,

	MOVEI	CH,"s"
	JRST	CNTO10
;PUT OUT ERROR MESSAGE (CONT'D)

;PUT OUT TEXT

CNTO6:	TSWT	FLTTY;
	TTCALL	3,(TA)

CNTO7:	ILDB	CH,TA
	JUMPE	CH,CNTO5
	PUSHJ	PP,PUTLST
	JRST	CNTO7

;PUT OUT NUMBER

CNTO9:	MOVE	TD,TE
CNTO9A:	IDIVI	TD,^D10
	HRLM	TC,(PP)
	SKIPE	TD
	PUSHJ	PP,CNTO9A

	HLRZ	CH,(PP)
	ADDI	CH,"0"

CNTO10:	TSWT	FLTTY;
	TTCALL	1,CH
	JRST	PUTLST
;PRINT OUT THE PROGRAM BREAK

PBREAK:	MOVE	OP,HILOC
	TSWF	FREENT		;RE-ENTRANT PROGRAM?
	JRST	PBRAK1		;YES

	MOVE	TE,[POINT 7,[ASCIZ "

PROGRAM BREAK IS "]]
	JRST	PBRAK2

PBRAK1:	MOVE	TE,[POINT 7,[ASCIZ "

HIGH SEGMENT BREAK IS "]]
	PUSHJ	PP,LSTMES
	HRRZ	TA,HPLOC
	ADD	OP,HPLOC
	SUBI	OP,400000
	PUSHJ	PP,LSCOD4

	MOVE	TE,[POINT 7,[ASCIZ "
LOW  SEGMENT BREAK IS "]]

PBRAK2:	PUSHJ	PP,LSTMES
	HRRZ	TA,HILOC
	PUSHJ	PP,LSCOD4
	SUB	OP,OBJSIZ
	JUMPLE	OP,LCRLF
	TTCALL	3,[ASCIZ "
%RPGCSE  'CORE SIZE TO EXECUTE' exceeded in object program

"]
	MOVE	TE,[POINT 7,[ASCIZ "

'CORE SIZE TO EXECUTE' exceeded by "]]
	PUSHJ	PP,LSTMES
	MOVE	TA,OP
	PUSHJ	PP,LSINC2
	JRST	LCRLF
;PUT OUT A DATA WORD ONTO BINFIL
;ENTER WITH DATA WORD IN TB, RELOCATION BITS IN TA

PUTDAT:	SKIPN	BINDEV			;ANY BINARY FILE?
	POPJ	PP,			;NO--RETURN

	IDPB	TA,RB			;PUT AWAY RELOCATION
	MOVEM	TB,(GP)			;PUT WORD IN NEXT SLOT
	AOS	DATGRP			;KICK UP ITEM COUNT
	AOBJN	GP,PDAT3		;BLOCK FULL YET?
	TSWF	FASSEG		;ARE WE IN OVERLAY SEGMENT?
	JRST	PDAT5		;YES
	MOVEI	TD,^D17		;NO
	MOVE	TE,[XWD -^D20,DATGRP]	;WRITE IT OUT

PDAT1:	AOS	DATGRP

PDAT2:	MOVE	CH,(TE)
	PUSHJ	PP,PUTBIN
	AOBJN	TE,PDAT2

	ADDM	TD,DATGRP+2

PDATI:	TSWF	FASSEG		;OVERLAY SEGMENT?
	JRST	PDAT7		;YES--USE OTHER ROUTINE

	MOVSI	TE,1B19		;RELOCATION FOR PC
	MOVEM	TE,DATGRP+1

	HRLZ	TE,BLKTYP
	MOVEM	TE,DATGRP
	MOVE	GP,[XWD -^D17,DATGRP+3]	;RESET POINTER
	MOVE	RB,[POINT 2,DATGRP+1,1]	;RESET RELOCATION BYTE POINTER

PDAT3:	POPJ	PP,			;RETURN
;WRITE OUT ANY ENTRIES IN GRPDAT

CLRDAT:	SKIPN	BINDEV		;FORGET THE WHOLE THING IF
	POPJ	PP,		;  NO BINARY BEING WRITTEN

	HRRZ	TE,DATGRP
	SKIPN	TE		;ANYTHING IN GRPDAT?
	JRST	PDATI

	MOVEI	TD,(TE)
	MOVNI	TE,3(TE)
	MOVSS	TE
	HRRI	TE,DATGRP
	TSWT	FASSEG;
	JRST	PDAT1

	ADD	TE,[XWD 2,1]
	JRST	PDAT6

;WRITE OUT 18 WORDS OF OVERLAY BINARY

PDAT5:	MOVE	TE,[XWD -^D19,DATGRP+1]

PDAT6:	MOVE	CH,(TE)
	PUSHJ	PP,PUTBIN
	AOS	OVRWRD
	AOBJN	TE,PDAT6

PDAT7:	SETZM	DATGRP+1
	SETZM	DATGRP
	MOVE	GP,[XWD -^D18,DATGRP+2]
	MOVE	RB,[POINT 2,DATGRP+1]
	POPJ	PP,
;WRITE OUT A SYMBOL DEFINITION

;ENTER WITH SYMBOL (IN RADIX 50) IN CH;   VALUE IN TA


PUTSYM:	SKIPN	BINDEV
	POPJ	PP,

	MOVE	TE,SYMLC1
	MOVEM	CH,0(TE)
	MOVEM	TA,1(TE)

	TSWT	FRELOC		;IF NOT RELOCATABLE,
	TDCA	TE,TE		;  USE 0,
	MOVEI	TE,1		;  ELSE USE 1

	IDPB	TE,SYMREL

	MOVEI	TE,2
	ADDM	TE,SYMLC1
	ADDM	TE,SYMGRP

	MOVE	TE,SYMREL
	TLNE	TE,770000
	POPJ	PP,

	MOVE	TE,[XWD -^D20,SYMGRP]
PSYM1:	MOVE	CH,0(TE)
	PUSHJ	PP,PUTBIN
	AOBJN	TE,PSYM1

PSYMI:	MOVSI	TE,2
	MOVEM	TE,SYMGRP
	SETZM	SYMGRP+1
	MOVEI	TE,SYMGRP+2
	MOVEM	TE,SYMLC1
	MOVE	TE,[POINT 4,SYMGRP+1]
	MOVEM	TE,SYMREL

	POPJ	PP,


;CLEAR OUT SYMGRP

CLRSYM:	HRRZ	TE,SYMGRP
	SKIPE	BINDEV
	SKIPN	TE
	POPJ	PP,

	ADDI	TE,2
	MOVNS	TE
	MOVSS	TE
	HRRI	TE,SYMGRP
	JRST	PSYM1
;ITEM IS INSTRUCTION

GETOPR:	LDB	OP,ASOP			;PICK UP OPERATOR
	CAIE	OP,ENDIT		;END OF INPUT?
	JRST	GETOP1
	LDB	TE,ASAC			;MAYBE--IS AC=17?
	CAIN	TE,17
	JRST	ENDASY			;YES

GETOP1:	CAIGE	OP,FSTUUO	;IS IT A UUO WHICH USES AC-FIELD TO DEFINE OP-CODE?
	JRST	GET2			;NO

	LDB	TE,ASAC		;YES--PICK UP AC-FIELD
	CAIG	OP,FSTUUO		;IS IT OPEN OR CLOSE?
	ANDI	TE,1			;YES--GET RID OF ALL BUT LOW-ORDER BIT
	LSH	TE,1			;DOUBLE IT
	MOVS	OP,UUOTBL-FSTUUO(OP)	;SET OP TO TABLE2
	ADD	OP,TE
	JRST	GET3

GET2:	LSH	OP,1
	ADDI	OP,OPTABL

GET3:	MOVE	TD,(OP)			;PICK UP PDP-10 OP-CODE
	DPB	TD,[POINT 9,TB,8]	;PUT IT INTO TB

	TLNN	TD,1		;ARE DECIMAL ADDRESSES ALLOWED?
	SWOFFS	FGDEC		;NO
	SWON	FGDEC		;YES

	PUSHJ	PP,GETADR		;GET ADDRESS IN RH OF TB

	JRST	PUTDAT			;PUT OUT ASSEMBLED WORD AND RETURN
;LIST A PDP-10 INSTRUCTION

LSTOPR:	PUSHJ	PP,LSTCOD		;LIST CONTENTS OF TB & ANY TAG
LOPR0:	MOVE	TA,1(OP)		;GET MNEMONICS FOR OPERATOR
	PUSHJ	PP,SIXOUT		;PRINT IT OUT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST
	SKIPL	0(OP)			;SHOULD WE PRINT AC?
	JRST	LOPR1

	MOVEI	CH,"1"			;YES
	TLNE	W1,400			;IS IT > 7?
	PUSHJ	PP,PUTLST		;YES--PRINT A 1

	LDB	CH,[POINT 3,W1,12]	;PRINT LOW-ORDER DIGIT
	ADDI	CH,"0"
	PUSHJ	PP,PUTLST

	MOVEI	CH,","
	PUSHJ	PP,PUTLST

LOPR1:	MOVEI	CH,"@"
	TLNE	W1,20			;IS INDIRECT BIT ON?
	PUSHJ	PP,PUTLST		;YES--PUT OUT "@"

	PUSHJ	PP,LSTADR		;LIST ADDRESS

	TLNE	W1,17			;ANY INDEX?
	PUSHJ	PP,PUTXR
	JRST	LCRLF			;NO--END OF LINE
;LIST A BYTE POINTER

LSTBYT:	PUSHJ	PP,LSTCOD		;LIST CONTENTS OF TB & ANY TAG

	MOVE	TA,[SIXBIT "POINT"]
	PUSHJ	PP,SIXOUT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST

	LDB	TE,[POINT 6,TB,11]	;PUT OUT BYTE SIZE
	PUSHJ	PP,DECIT
	MOVEI	CH,","
	PUSHJ	PP,PUTLST

	MOVEI	CH,"@"			;PUT OUT ANY INDIRECT
	TLNE	TB,20
	PUSHJ	PP,PUTLST

	PUSHJ	PP,LSTADR		;LIST ADDRESS

	TLNE	TB,17			;ANY INDEX?
	PUSHJ	PP,PUTXR		;YES--LIST IT

	LDB	TD,[POINT 6,TB,5]	;GET RESIDUE
	CAIN	TD,^D36			;IS IT 36?
	JRST	LCRLF			;YES--DONE

	MOVEI	CH,","			;NO--LIST IT
	PUSHJ	PP,PUTLST
	MOVEI	TE,^D35
	SUB	TE,TD
	PUSHJ	PP,DECIT
	JRST	LCRLF
;LIST AN XWD

LSTXWD:	PUSH	PP,TC		;SAVE SECOND WORD
	PUSHJ	PP,LSTCOD	;LIST ASSEMBLED WORD AND ANY TAG
	MOVE	TA,[SIXBIT "XWD"]
	PUSHJ	PP,SIXOUT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST

	HLRZ	W2,W1		;LIST LEFT-HALF
	PUSHJ	PP,LSTADR

	MOVEI	CH,","		;PUT OUT COMMA
	PUSHJ	PP,PUTLST

	POP	PP,W1		;GET BACK SECOND WORD
	HLRZ	W2,W1		;LIST RIGHT-HALF
	PUSHJ	PP,LSTADR

	JRST	LCRLF		;PUT OUT <C.R.>,<L.F.> AND RETURN
;LIST ADDRESS

;LIST THE OPERAND IN THE ADDRESS

LSTADR:	MOVE	DT,W1
	ANDI	DT,77777
	LDB	TD,ADRTYP
	XCT	ADRTB2(TD)

	PUSHJ	PP,LSTNAM
	SWOFF	FASEXT;
	TRNE	W2,700000
	POPJ	PP,
	JRST	LSTINC


LSTFTB:	MOVE	TA,[SIXBIT "%FTB"]
	PUSHJ	PP,SIXOUT
	MOVE	W2,W1
	ANDI	W2,77777
	PJRST	LSTINC

;LIST ADDRESSES   (CONT'D)

;EXTERNAL NAME
LSTEXT:	ADD	DT,EXTLOC
	TSWF	FASSEG		;ARE WE IN OVERLAY SEG?
	JRST	LSTEX1		;YES
	TLNE	TB,(Z @0)	;IF INDIRECT BIT IS OFF,
	TSWF	FREENT		;  OR PROGRAM IS RE-ENTRANT,
	JRST	LSTEX2		;  PRINT IN A NORMAL WAY

LSTEX1:	HRRZ	TA,TB
	PUSHJ	PP,LSINC2
	MOVE	TE,[POINT 7,[ASCIZ "		;"]]
	PUSHJ	PP,LSTMES
	PUSHJ	PP,LSTNAM
	TSWF	FREENT		;DON'T DO THIS IF REENT
	POPJ	PP,
	TSWF	FASSEG;
	SKIPGE	TE,1(DT)	;TABLE ENTRY = FULL-WORD -1?
				;(NOT SURE THIS EVER HAPPENS)
	POPJ	PP,
	CAIN	TE,-1		;RH ENTRY = -1?
	POPJ	PP,

	AOS	GAERAS
	MOVE	TE,[POINT 7,[ASCIZ "	******NO FLAG IN EXTAB******"]]
	JRST	LSTMES

LSTEX2:	SWON	FASEXT		;NO
	PUSHJ	PP,LSTNAM
	SWOFF	FASEXT;
	TRNN	W2,700000
	JRST	LSTINC
	POPJ	PP,
;LIST ADDRESSES  (CONT'D).

;CONSTANT > 77777
LSTCON:	HRRZ	TA,W2
	JRST	LSCONX

;CONSTANT < 100000
LSCON1:	HRRZ	TA,W1
	ANDI	TE,77777

LSCONX:	TSWT	FGDEC;		;ARE WE ALLOWED TO PRINT IN DECIMAL?
	JRST	LSINC2		;NO
	JRST	LSINC4		;YES--USE DECIMAL


;SPECIAL TAG
LSTTAG:	MOVEI	CH,"%"
	PUSHJ	PP,PUTLST
	MOVE	TC,W1
	ANDI	TC,77777
	PUSHJ	PP,LSINC5
	JRST	LSTINC

;MISCELLANEOUS
LSTMIS:	LDB	TD,INCTYP
	ANDI	W2,77777
	XCT	INCTB2(TD)
	PUSHJ	PP,SIXOUT
	JRST	LSTINC


;INCREMENT TO DATA DIVISION

INCDAT:	HRRZ	TA,W2
	JRST	LSINC1
;LIST ANY INCREMENT (IN W2) IN OCTAL

LSTINC:	MOVE	TA,W2
	TRNN	TA,77777
	  POPJ	PP,
	MOVEI	CH,"+"
	CAILE	TA,70000		; IS IT .-  ?
	  JRST	LSINC7			; YES -
	PUSHJ	PP,PUTLST
LSINC1:	ANDI	TA,77777
LSINC2:	MOVE	TD,[POINT 3,TA,17]	;NO
	ILDB	CH,TD
	TLNE	TD,770000
	  JUMPE	CH,.-2

LSINC3:	ADDI	CH,"0"
	PUSHJ	PP,PUTLST
	TLNN	TD,770000
	  POPJ	PP,
	ILDB	CH,TD
	JRST	LSINC3



;LIST ANY INCREMENT IN DECIMAL

LSINC4:	HRRZ	TC,TA
	CAIG	TC,7
	JRST	LSINC5
	MOVEI	CH,"^"
	PUSHJ	PP,PUTLST
	MOVEI	CH,"D"
	PUSHJ	PP,PUTLST

;ENTER HERE FROM LSTTAG

LSINC5:	PUSH	PP,TB		;SAVE ANY ASSEMBLED WORD
	HRRZI	TA,0

LSINC6:	IDIVI	TC,^D10
	ADDI	TB,20
	LSHC	TB,-6
	JUMPN	TC,LSINC6
	PUSHJ	PP,SIXOUT	;PRINT THE NUMBER
	POP	PP,TB		;RESTORE THE ASSEMBLED WORD
	POPJ	PP,

LSINC7:	MOVEI	CH,"-"			; GET A MINUS
	PUSHJ	PP,PUTLST		; STASH ONTO LISTING
	MOVNS	TA			; GET POSITIVE NUMBER
	JRST	LSINC1			; AND CONTINUE
;LIST INDEX

PUTXR:	MOVEI	CH,"("
	PUSHJ	PP,PUTLST
	MOVEI	CH,"1"
	TLNE	W1,10		;IS INDEX > 7?
	PUSHJ	PP,PUTLST	;YES--PUT OUT THE "1"
	LDB	CH,[POINT 3,W1,17]
	ADDI	CH,"0"
	PUSHJ	PP,PUTLST
	MOVEI	CH,")"

	JRST	PUTLST		;PUT OUT PAREN AND RETURN

;LIST A NAMTAB ENTRY
;ENTER WITH RH OF DT CONTAINING THE ADDRESS OF A TABLE ENTRY.

LSTNAM:	HLRZ	TA,0(DT)
	ANDI	TA,LMASKB
LSNAM0:	MOVEI	TE,0
	JUMPE	TA,LSNAM1	;ZERO ENTRY?

	ADD	TA,NAMLOC	; ADD IN BASE OF NAMTAB
	HRRZ	TD,NAMNXT	;IS IT OUT OF NAMTAB?
	CAIGE	TD,(TA)
LSNAM1:	SKIPA	TD,[POINT 6,[SIXBIT "??UNKNOWN??"]]

	MOVE	TD,[POINT 6,1(TA)]	;NO
	JRST	LSNAM3

LSNAM2:	ADDI	TE,1
	PUSHJ	PP,PUTLST
LSNAM3:	ILDB	CH,TD
	JUMPN	CH,.+2		; DONE?
	POPJ	PP,		;YES--EXIT

	ADDI	CH,40
	CAIN	CH,";"		;IS IT A SEMI-COLON?
	MOVEI	CH,"."		;YES--USE PERIOD
	CAIE	CH,":"		;IS IT A COLON?
	JRST	LSNAM2		;NO

	TSWT	FASEXT;		;YES--PRINTING AN EXTERNAL-NAME?
	TRCA	CH,27		;NO--USE "-"
	MOVEI	CH,"$"		;YES--USE "$"
	JRST	LSNAM2
;LIST A SIXBIT CONSTANT

LSTSIX:	SKIPA	DT,[POINT 6,TB]


;LIST AN ASCII CONSTANT

LSTASC:	MOVE	DT,[POINT 7,TB]
	TSWT	FNOLST	;ANY LISTING?
	PUSHJ	PP,LISTPC	;YES--LIST PC

	MOVE	OP,[POINT 7,GHOLD]
	MOVEI	W2,42

ASCSX1:	PUSHJ	PP,GETASY
	MOVE	TB,CH
	MOVEI	TA,0
	PUSHJ	PP,PUTDAT
	ADDI	PC,1
	TSWT	FNOLST	;ANY LISTING?
	JRST	ASCSX2

	SOJG	TC,ASCSX1
	POPJ	PP,

ASCSX2:	ILDB	CH,DT
	TLNN	DT,100
	ADDI	CH,40
	CAIN	CH,42
	MOVEI	W2,"/"
	SKIPE	CH
	IDPB	CH,OP
	TLNE	DT,760000
	JRST	ASCSX2

	HRRI	DT,TB-1
	SOJG	TC,ASCSX1

	MOVEI	CH,0		;SET "END OF CONSTANT"
	IDPB	CH,OP
;LIST A SIXBIT OR ASCII CONSTANT  (CONT'D)

	MOVEI	CH,11		;PUT OUT TWO TABS
	PUSHJ	PP,PUTLST
	PUSHJ	PP,PUTLST
	SKIPE	TAGOUT		;ANY TAGS?
	JRST	ASCSX3		;NO

	MOVE	TC,SAVTAG
	PUSHJ	PP,MSTAG4

ASCSX3:	SETOM	TAGOUT

	TLNN	DT,100		;ASCII?
	SKIPA	TE,[POINT 7,[ASCIZ "	SIXBIT	"]];NO
	MOVE	TE,[POINT 7,[ASCIZ "	ASCII	"]];YES
	PUSHJ	PP,LSTMES

	MOVE	CH,W2
	PUSHJ	PP,PUTLST
	MOVE	TE,[POINT 7,GHOLD]
	PUSHJ	PP,LSTMES
	MOVE	CH,W2
	PUSHJ	PP,PUTLST
	JRST	LCRLF
;LIST A ONE-WORD DECIMAL CONSTANT

LSTD1:	MOVE	TA,[SIXBIT "DEC"]
	PUSHJ	PP,SIXOUT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST

	MOVE	TE,TB
	JRST	DECIT
;LIST A TWO-WORD DECIMAL CONSTANT

LSTD2:	MOVE	TA,[SIXBIT "DEC"]
	PUSHJ	PP,SIXOUT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST

	PUSHJ	PP,GETASY
	PUSH	PP,CH
	PUSH	PP,TB
	MOVE	TB,CH
	MOVEI	TA,0
	PUSHJ	PP,PUTDAT
	SUBI	CT,1
	POP	PP,TD		;TD_LEFT HALF
	MOVE	TC,(PP)		;TC_RIGHT HALF

	JUMPGE	TD,LSTD2A	;IS IT NEGATIVE?
	MOVEI	CH,"-"		;YES -- PUT OUT MINUS SIGN
	PUSHJ	PP,PUTLST
	SETCA	TD,		;MAKE THE VALUE POSITIVE
	MOVNS	TC
	TLZ	TC,1B18
	SKIPN	TC
	ADDI	TD,1

LSTD2A:	JUMPE	TD,LSTD2D
	DIV	TD,[DEC 10000000000]
	PUSH	PP,TC
	MOVE	TE,TD
	PUSHJ	PP,DECIT
	POP	PP,TD

	SKIPA	TB,[XWD -^D9,DECTAB]
LSTD2B:	MOVE	TD,TC
	IDIV	TD,(TB)
	MOVEI	CH,"0"(TD)
	PUSHJ	PP,PUTLST
	AOBJN	TB,LSTD2B

	MOVEI	CH,"0"(TC)
	PUSHJ	PP,PUTLST

LSTD2C:	PUSHJ	PP,LCRLF

	ADDI	PC,1

	POP	PP,TB
	JRST	LSTCOD

LSTD2D:	MOVE	TE,TC
	PUSHJ	PP,DECIT
	JRST	LSTD2C
;ASSEMBLE A FLOATING POINT CONSTANT

FLTCON:	PUSH	PP,LN		;SAVE LN
	SUBI	CH,^D8		;REDUCE EXPONENT BY 8
	MOVEM	CH,FLTC1	;SAVE EXPONENT
	PUSHJ	PP,GETASY	;GET AND SAVE MANTISSA
	MOVEM	CH,FLTC2

	SUBI	CT,1		;DECREMENT WORD COUNT

	MOVEI	TB,0		;CLEAR TB
	SKIPA	TD,[POINT 4,FLTC2,3]

FLTCN1:	IMULI	TB,^D10		;CREATE MANTISSA
	ILDB	TC,TD
	ADD	TB,TC
	TLNE	TD,770000
	JRST	FLTCN1

	JUMPE	TB,FLTC12	;ZERO?

	MOVEI	LN,243		;MAXIMUM BINARY EXPONENT

FLTCN2:	TLNE	TB,777777	;IF MANTISSA
	JRST	FLTCN3	;  IS ZERO IN LEFT-HALF,
	SUBI	LN,^D17		;  DECREMENT EXPONENT AND
	LSH	TB,^D17		;  SHIFT MANTISSA
FLTCN3:		TLNE	TB,777000	;IF MANTISSA
	JRST	FLTCN4		;  IS ZERO IN FIRST 8 BITS,
	LSH	TB,^D8		;  SHIFT LEFT
	SUBI	LN,^D8		;  AND DECREMENT EXPONENT
FLTCN4:	TLNE	TB,(1B1)	;SHIFT MANTISSA
	JRST	FLTCN5		;  UNTIL BIT 1
	LSH	TB,1		;  IS NON-ZERO
	SOJA	LN,FLTCN4

FLTCN5:	MOVM	TE,FLTC1	;GET TENS EXPONENT
	CAILE	TE,^D100	;IF TOO BIG,
	JRST	FLTBIG		;  FORGET IT
	JUMPE	TE,FLTCN9	;IF ZERO, WE'RE DONE

FLTCN6:	MOVEI	TC,0		;SET 'LEFT OVER' TO ZERO
	CAIG	TE,^D38		;IF EXPONENT
	JRST	FLTCN7		;  IS GREATER THAN 38
	MOVEI	TC,-^D38(TE)	;  SAVE 'LEFT OVER'
	MOVEI	TE,^D38		;  AND RESET EXPONENT TO 38

FLTCN7:	SKIPGE	FLTC1		;POSITIVE EXPONENT?
	MOVNS	TE		;NO--GET NEGATIVE

	MUL	TB,FLTAB1(TE)	;MULTIPLY BY TABLE VALUE

	TLNE	TB,(1B1)	;IF NO
	JRST	FLTCN8		;  NORMALIZED,
	LSH	TB,1		;  THEN NORMALIZE IT
	SUBI	LN,1

FLTCN8:	IDIVI	TE,4		;GET EXPONENT FROM
	LDB	TE,FLTAB2(TD)	;  TABLE
	ADDI	LN,-200(TE)	;ADD TO THE ONE WE'VE BEEN CARRYING
	SKIPE	TE,TC		;IF ANY EXPONENT WAS LEFT OVER,
	JRST	FLTCN6		;  MAKE ANOTHER ITERATION

FLTCN9:	ADDI	TB,200		;ROUND THE MANTISSA
	JUMPGE	TB,FLTC10	;IF NECESSARY,
	LSH	TB,-1		;  ADJUST MANTISSA
	ADDI	LN,1		;  AND EXPONENT

FLTC10:	TRNE	LN,777400	;IF EXPONENT IS TOO BIG,
	JRST	FLTBIG		;  WE LOSE
	LSH	TB,-^D8		;MAKE ROOM FOR EXPONENT
	DPB	LN,[POINT 9,TB,8];STASH EXPONENT
	LDB	TA,[POINT 4,FLTC2,3];GET SIGN OF ITEM
	SKIPE	TA		;IF NOT POSITIVE,
	MOVNS	TB		;  NEGATE THE RESULT

FLTC12:	MOVEI	TE,^D8		;BUMP EXPONENT
	ADDM	TE,FLTC1	;  TO ORIGINAL VALUE
	POP	PP,LN		;RESTORE LN
	POPJ	PP,

FLTBIG:	MOVE	TE,[POINT 7,[ASCIZ "
				****** BAD COMP-1 CONSTANT ******

"]]
	PUSHJ	PP,LSTMES
	AOS	GAERAS
	MOVNI	TB,3
	ADDM	TB,PAGCNT
	MOVEI	TB,0
	JRST	FLTC12
;LIST A FLOATING POINT CONSTANT

LSTFLT:	MOVE	TA,[SIXBIT "FLOAT"]
	PUSHJ	PP,SIXOUT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST

	LDB	CH,[POINT 4,FLTC2,3]	;IS THE VALUE POSITIVE?
	JUMPE	CH,LSFLT1
	MOVEI	CH,"-"
	PUSHJ	PP,PUTLST

LSFLT1:	MOVE	TA,[SIXBIT "0."]
	PUSHJ	PP,SIXOUT

	MOVE	TA,[POINT 4,FLTC2,3]
	MOVEI	TB,10

LSFLT2:	ILDB	CH,TA
	ADDI	CH,"0"
	PUSHJ	PP,PUTLST
	SOJG	TB,LSFLT2

	SKIPN	TE,FLTC1
	POPJ	PP,

	MOVEI	CH,"E"
	PUSHJ	PP,PUTLST
	JRST	DECIT
;PUT LOCATION, ASSEMBLED WORD, AND ANY TAG ONTO LSTFIL

LSTCOD:	PUSHJ	PP,LISTPC

	HLRZ	TD,TB		;PRINT LH OF ASSEMBLED WORD
	MOVE	TE,[POINT 3,TD,17]
	PUSHJ	PP,LSCOD3

	MOVEI	CH," "
	TRNE	TA,1B34
	MOVEI	CH,"'"
	PUSHJ	PP,PUTLST
	MOVEI	CH," "
	PUSHJ	PP,PUTLST

	MOVE	TE,[POINT 3,TB,17]	;PRINT RH OF ASSEMBLED WORD
	PUSHJ	PP,LSCOD3

	MOVEI	CH," "
	TRNE	TA,1B35
	MOVEI	CH,"'"
	PUSHJ	PP,PUTLST

	MOVEI	CH,11
	PUSHJ	PP,PUTLST
	SKIPE	TAGOUT		;A SINGLE TAG TO BE LISTED?
	JRST	LSCOD2		;NO


LSCOD1:	MOVE	TC,SAVTAG
	PUSHJ	PP,MSTAG4

LSCOD2:	SETOM	TAGOUT
	MOVEI	CH,11
	JRST	PUTLST		;PUT OUT TAB AND RETURN

LSCOD4:	MOVE	TE,[POINT 3,TA,17]

LSCOD3:	ILDB	CH,TE		;PRINT A HALF-WORD
	ADDI	CH,"0"
	PUSHJ	PP,PUTLST
	TLNE	TE,770000
	JRST	LSCOD3
	POPJ	PP,
;PRINT OUT CURRENT PC

LISTPC:	SKIPLE	TAGOUT		;ANY TAGS OUT?
	PUSHJ	PP,LCRLF	;YES -- FINISH THE LINE

	TSWTZ	FASPAR;		;ANY PARAGRAPH NAME OUT?
	SKIPL	TAGOUT		;NO -- ANY TAG LINE?
	PUSHJ	PP,LCRLF	;YES -- PUT OUT ANOTHER <C.R.>

	MOVE	TE,[POINT 3,PC,17]	;PRINT LOCATION COUNTER
	PUSHJ	PP,LSCOD3
	MOVEI	CH,"'"
	TSWF	FRELOC;
	PUSHJ	PP,PUTLST
	MOVEI	CH,11
	JRST	PUTLST
;PUT LOCATION IN RH OF "TB", SET RELOCATION IN TA.
;OPERAND IS IN RH OF "W1".

GETADR:	LDB	TD,ADRTYP
	MOVE	TE,W1
	ANDI	TE,77777
	XCT	ADRTB1(TD)
	MOVEI	TA,1
	ADD	TB,W2
	POPJ	PP,

;ADDRESS IS A CONSTANT
ADRCON:	MOVEI	TA,0
	HRR	TB,TE
	POPJ	PP,

;ADDRESS IS IN EXTAB
ADREXT:	CAIGE	TE,NUMEXT	;IS IT A RPGLIB ROUTINE?
	TSWF	FREENT		;YES--IS THIS A RE-ENTRANT PROGRAM?
	JRST	ADEXT4		;RE-ENTRANT, OR NOT LIBOL ROUTINE

	LSH	TE,-1
	TLO	W1,1B31
	MOVEI	TA,0
	HRRI	TB,140+FIXNUM(TE)
	TLO	TB,1B31
	POPJ	PP,

ADEXT4:	ADD	TE,EXTLOC	;GET EXTTAB LOCATION
	HRRZ	TD,1(TE)	;PICK UP ADDRESS

ADEXT0:	HRRM	PC,1(TE)	;SET LINK TO CURRENT LOCATION
	CAIN	TD,-1		;IS THIS FIRST REFERENCE?
	JRST	ADEXT3		;YES

ADEXT1:	HRR	TB,TD		;GET LINK ADDRESS
	MOVEI	TA,1		;SET RELOCATION ON
	POPJ	PP,		;RETURN

ADEXT3:	HLLZS	TB		;SET ADDRESS TO ZERO
	MOVEI	TA,0		;TURN RELOCATION OFF
	POPJ	PP,		;RETURN
;ADDRESS IS IN PROTAB
ADRPRO:	HRRZ	DT,PROLOC	;GET ADDRESS OF PROTAB ENTRY
	ADD	DT,TE
	HRR	TB,(DT)		;PICK UP THAT LOCATION
	LDB	TE,PTSEGN	;IS IT IN THE RESIDENT SEGMENT?
	JUMPN	TE,ADPRO2
	ADD	TB,RESDNT	;YES--RELOCATE
	POPJ	PP,

ADPRO2:	ADD	TB,NONRES	;RELOCATE TO NON-RESIDENT SEGMENT
	POPJ	PP,

;ADDRESS IS AN OCHTAB ENTRY

ADRTAG:	HRRZ	DT,OCHLOC		; GET BOTTOM OF OCHTAB
	ADD	DT,TE			; ADD OUT INCREMENT
	HRR	TB,1(DT)		; GET THE WORD
	ADD	TB,OCHBAS		; ADD IT TO OCHBAS
	POPJ	PP,			; EXIT

;ADDRESS IS OBJECT TIME FILE TABLE

ADRFIL:	HRR	TB,TE
	MOVE	W2,FTBBAS##
	POPJ	PP,

;ADDRESS IS IN ICHTAB

ADRDAT:	HRRZ	TA,ICHLOC##
	ADD	TA,TE

ADRD3:	HRR	TB,1(TA)
	ADD	TB,ICHBAS	;IF NOT ADD IN BASE OF DATA AREA
	POPJ	PP,
;THE INCREMENT IS A CONSTANT

INCCON:	HRR	TB,W2		;SET VALUE
	MOVEI	TA,0		;NO RELOCATION
	POPJ	PP,

;THE INCREMENT IS MISCELLANEOUS

INCMIS:	LDB	TE,INCTYP
	XCT	INCTB1(TE)
	MOVE	TD,W2
	ANDI	TD,77777
	CAILE	TD,70000		; NEGATIVE INCREMENT?
	  ADD	TD,[XWD 777777,700000]	; YES - CONVERT TO FULL WORD
	ADD	TB,TD
	MOVEI	TA,1		;RELOCATED
	POPJ	PP,

;IMPROPER INCREMENT

BADINC:	MOVE	TE,[POINT 7,[ASCIZ "

				******** BAD INCREMENT *********
"]]
	PUSHJ	PP,LSTMES
	AOS	GAERAS
	MOVNI	TE,3
	ADDM	TE,PAGCNT
	HRRI	TB,0
	POPJ	PP,

;%TEMP INCREMENTS

TMPINC:	HRR	TB,TEMBAS
	POPJ	PP,

TMPLST:	MOVE	TA,[SIXBIT '%TEMP']
	POPJ	PP,
;CONVERT A SIXBIT WORD TO RADIX 50.
;ENTER WITH THE WORD IN TC;   EXIT WITH VALUE IN CH.

RADX50:	MOVEI	CH,0
	MOVE	TE,[POINT 6,TC]

RDX50A:	ILDB	TD,TE
	JUMPE	TD,RDX50C
	IMULI	CH,50

	CAIN	TD,";"-40	;IS IT A SEMI-COLON?
	JRST	RDX50D		;YES

	CAIN	TD,"%"-40
	  JRST	RDX50F

	CAIGE	TD,"A"-40
	CAIG	TD,"9"-40
	SKIPA
	JRST	RDX50B

	CAIN	TD,"."-40
	MOVEI	TD,45+17+7

	SUBI	TD,17
	CAILE	TD,12
	SUBI	TD,7

	CAIG	TD,46
	SKIPGE	TD
RDX50B:	MOVEI	TD,46
RDX50E:	ADD	CH,TD

	TLNE	TE,770000
	JRST	RDX50A

RDX50C:	POPJ	PP,

RDX50F:	TROA	TD,47		; use RAD50 "%"
RDX50D:	MOVEI	TD,45		;CHANGE ";" TO "."
	JRST	RDX50E
;LIST AN OCTAL CONSTANT

LSTOCT:	MOVE	TA,[SIXBIT "OCT"]
	PUSHJ	PP,SIXOUT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST

	MOVE	TA,[POINT 3,TB]

LSOCT1:	ILDB	CH,TA
	TLNE	TA,770000
	JUMPE	CH,LSOCT1

LSOCT2:	ADDI	CH,"0"
	PUSHJ	PP,PUTLST
	TLNN	TA,770000
	POPJ	PP,
	ILDB	CH,TA
	JRST	LSOCT2


;PRINT OUT THE DECIMAL VALUE IN TE

DECIT:	JUMPGE	TE,DECIT1
	MOVEI	CH,"-"
	PUSHJ	PP,PUTLST
	MOVMS	TE
DECIT1:	IDIVI	TE,^D10
	HRLM	TD,(PP)
	SKIPE	TE
	PUSHJ	PP,DECIT1
	HLRZ	CH,(PP)
	ADDI	CH,"0"
	JRST	PUTLST


;PRINT OUT A SIXBIT WORD

SIXOUT:	MOVE	TE,[POINT 6,TA]
SIXOT1:	ILDB	CH,TE
	JUMPE	CH,SIXOT2
	ADDI	CH,40
	PUSHJ	PP,PUTLST
	TLNE	TE,770000
	JRST	SIXOT1
SIXOT2:	POPJ	PP,
;PUT OUT THE FIRST LINES OF CODE:
;		JSP 14,RESET. [201]
;		JRST <PROCEDURE-NAME>

STARTI:	PUSHJ	PP,CLRDAT	;CLEAR DATGRP
	MOVE	PC,RESDNT
	SUB	PC,FIXEDS
	HRRZM	PC,DATGRP+2

;PUT OUT A START BLOCK
	MOVE	CH,[XWD 7,1]
	PUSHJ	PP,PUTBIN
	MOVSI	CH,200000
	PUSHJ	PP,PUTBIN
	HRRZ	CH,PC
	PUSHJ	PP,PUTBIN

STRT2:	PUSHJ	PP,HDROUT
	PUSHJ	PP,LCRLF

SC==0		;INITIAL COUNT OF START INSTRUCTIONS	[201].
SRT==SC	
;
	TSWT	FREENT		;RE-ENTRANT CODE?
	JRST	STRT10		;NO -- GETSEG NEEDED
	MOVE	TE,[POINT 7, [ASCIZ "START.:"]]
	PUSHJ	PP,STRTI8
;PUT OUT THE "JSP"

STRTI9:	MOVSI	TB,(JSP 14,)
	TSWF	FREENT;
	JRST	STRT9C

	HRRI	TB,400010
	MOVEI	TA,0
	JRST	STRT9D

STRT9C:	MOVEI	W2,0
	MOVEI	W1,RESET##	;EXTAB ADDR OF RESET.
	PUSHJ	PP,GETADR
STRT9D:	PUSHJ	PP,PUTDAT

	SETOM	TAGOUT

	TSWT	FREENT;
	SKIPA	TE,[POINT 7,[ASCIZ "	JSP	14,400010	;RESET."]]
	MOVE	TE,[POINT 7,[ASCIZ "	JSP	14,RESET."]]	; [201]
	PUSHJ	PP,STRTI8
	SC==SC+1

;PUT OUT "XWD 0,PROGRAM-ENTRY+1"

	HRRZ	TB,RESDNT	;GET CODE BASE
	HRRZ	TC,PRGENT##	;ADD ON ENTRY POINT
	ANDI	TC,77777
	ADDI	TB,(TC)
	MOVEI	TA,1		;RELATIVE
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "	XWD	0,"]]
	PUSHJ	PP,LISTIT
	MOVE	TA,PRGID
	PUSHJ	PP,SIXOUT
	PUSHJ	PP,LCRLF
	AOJ	PC,
	SC==SC+1

;PUT OUT "AOS %CALLFLAG"

	HRRZ	TB,IMPPAR	;GET BASE OF %PARAM
	HRRZ	TC,RETPTR##
	ANDI	TC,77777
	ADDI	TB,(TC)
	HRLI	TB,(AOS)
	MOVEI	TA,1		;RELATIVE
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "	AOS	%PARAM"]]
	PUSHJ	PP,STRTI8
	SC==SC+1

MCSEND:
;PUT OUT "JRST" TO BEGINNING OF CODE

	HRRZ	TB,PROGST		; GET START OF CODE
	HRLI	TB,(JRST)		; GET THE INSTRUCTION
	MOVEI	TA,1			; RELOCATE
	PUSHJ	PP,PUTDAT		; OUTPUT
	MOVE	TE,[POINT 7,	[ASCIZ "	JRST	"]]
	PUSHJ	PP,LISTIT
	MOVE	TA,PRGID		; GET PROGRAM NAME
	PUSHJ	PP,SIXOUT		; OUTPUT IT
	PUSHJ	PP,LCRLF		; DO A RTNL
	AOJ	PC,
	SC==SC+1

	JRST	CLRDAT

STRTS==:SC		;NUMBER OF WORDS OF START CODE

;PUT OUT MESSAGE, FOLLOWED BY <C.R.>,<L.F.>, AND BUMP PC

STRTI8:	PUSHJ	PP,LISTIT
	AOJA	PC,LCRLF
;PUT OUT 'GETSEG' CODE

GC==0		;INIT COUNT OF GETSEG + START INSTRUCTIONS

STRT10:	MOVSI	TB,(MOVEI 1,)	;PUT OUT "MOVEI 1,%RPGLB"
	HRR	TB,RESDNT
	ADDI	TB,GETSGC-6
	SUB	TB,FIXEDS
	MOVEI	TA,1
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "START.:	MOVEI	1,%RPGLB"]]	; [201]
	PUSHJ	PP,STRTI8
	GC==GC+1

	MOVE	W1,[EXP 132B8+1B12+40B35]	;PUT OUT "CALLI 1,40"
	MOVEI	W2,0
	MOVE	TB,W1
	PUSHJ	PP,GETOPR
	PUSHJ	PP,LSTOPR
	ADDI	PC,1
	GC==GC+1

	MOVSI	TB,(JRST 4,)	;PUT OUT "JRST 4,."
	HRR	TB,RESDNT
	SUB	TB,FIXEDS
	ADDI	TB,2
	MOVEI	TA,1
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "	JRST	4,."]]
	PUSHJ	PP,STRTI8
	GC==GC+1

	MOVSI	TB,(MOVEI 16,)	;PUT OUT "MOVEI 16,ADDR OF RPGLIB ARGS"
	HRR	TB,RPGVER##
	ADD	TB,LITBAS
	MOVEI	TA,1
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "	MOVEI	16,%LIT		;RPGLIB arguments"]]
	PUSHJ	PP,STRTI8
	GC==GC+1

	PUSHJ	PP,STRTI9
	GC==GC+SC

	PUSHJ	PP,LCRLF

	MOVE	TC,[IOWD 6,GETTAB]
STRTI4:	ADDI	TC,1		;PUT OUT
	MOVE	TB,(TC)		;  SIXBIT "SYS"
	MOVEI	TA,0		;  SIXBIT "RPGLIB"
	PUSHJ	PP,PUTDAT	;  SIXBIT "SHR"
	MOVE	TE,1(TC)	;  Z
	PUSHJ	PP,STRTI8	;  Z
	AOBJN	TC,STRTI4	;  Z
	GC==GC+6

	JRST	CLRDAT

GETSGC==:GC		;NUMBER OF WORDS OF GETSEG CODE + START CODE

PRINTC==GETSGC-6-12

;PUT OUT THE FIXED PORTION OF CODE:

;	OTFBAS:	XWD	0,OTFBAS
;	MEMRY.:	OCT	OBJSIZ
;	TOTBAS:	XWD	0,%TOT
;	TABDEX:	OCT	0
;	FTBBAS:	XWD	0,FTBBAS
;	PUSHL.:	OCT	200
;	FRCFIL:	OCT	0
;	ARRBAS:	XWD	0,ARRBAS
;	STKLST:	XWD	0,.STLST

	FIXNUM==^D9		;NUMBER OF FIXED ITEMS
				;(MUST AGREE WITH FIXNUM IN RPGIIE)

;PUT OUT "XWD 0,OTFBAS"
FIXED:	PUSHJ	PP,CLRDAT	;CLEAR OUT DATGRP
	HRRZM	PC,DATGRP+2
	PUSHJ	PP,LCRLF

	HRRZ	TB,OTFBAS	;ASSUME THERE ARE FILES
	MOVEI	TA,1
	MOVE	TE,OTFLOC##	;ARE THERE ANY FILES?
	CAMN	TE,OTFNXT##
	SETZB	TA,TB		;NO--PUT OUT UNRELOCATED ZERO

	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "%OTFBS:	XWD	0,"]]
	PUSHJ	PP,LISTIT
	MOVE	TA,TB
	PUSHJ	PP,LSINC2
	PUSHJ	PP,LCRLF
	ADDI	PC,1
;PUT OUT "MEMRY.: OCT <MEMORY-SIZE>"

	HRRZ	TB,OBJSIZ
	SUBI	TB,1
	IORI	TB,1777
	MOVEI	TA,0
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "%MEMRY:	OCT	"]]
	PUSHJ	PP,LISTIT
	HRRZ	TA,TB
	PUSHJ	PP,LSINC2
	PUSHJ	PP,LCRLF
	ADDI	PC,1


;Put out "TOTBAS: XWD   0,%TOT"

	HRRZ	TB,NONRES##
	MOVEI	TA,1
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,	[ASCIZ "%TOTBS:	XWD	0,"]]
	PUSHJ	PP,LISTIT
	HRRZ	TA,TB
	PUSHJ	PP,LSINC2
	PUSHJ	PP,LCRLF
	ADDI	PC,1


;PUT OUT "TABDEX: OCT 0"

	SETZB	TA,TB
	TSWF	F1P;			; 1P REPEAT ON?
	  MOVEI	TB,1			; YES - FLAG IT
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,	[ASCIZ "%TBDEX:	OCT	"]]
	PUSHJ	PP,LISTIT
	HRRZ	TA,TB			; GET DATA INTO PROPER AC
	PUSHJ	PP,LSINC2
	PUSHJ	PP,LCRLF
	ADDI	PC,1
;PUT OUT "FTBBAS:  XWD    0,FTBBAS"

	HRRZ	TB,FTBBAS
	ADDI	TB,32			; [153] Add in device table offset
	MOVEI	TA,1
	MOVE	TE,FTBLOC##		; ARE THERE ANY FILES?
	CAMN	TE,FTBNXT##
	  SETZB	TA,TB			; NO - OUTPUT NON-RELOCATED ZERO
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,	[ASCIZ "%FTBAS:	XWD	0,"]]
	PUSHJ	PP,LISTIT
	HRRZ	TA,TB
	PUSHJ	PP,LSINC2
	PUSHJ	PP,LCRLF
	ADDI	PC,1


;PUT OUT "PUSHL.: OCT   200"

	MOVEI	TB,200			; GET THAT CONSTANT
	MOVE	TA,0			; NON-RELOCATABLE
	PUSHJ	PP,PUTDAT		; OUTPUT
	MOVE	TE,[POINT 7,[ASCIZ "%PUSHL:	OCT	"]]
	PUSHJ	PP,LISTIT		; OUTPUT TO LISTING
	HRRZ	TA,TB			; GET THAT DATA
	PUSHJ	PP,LSINC2		; OUTPUT DATA
	PUSHJ	PP,LCRLF		; DO A CRLF
	ADDI	PC,1			; AND BUMP THAT PC


;Put out "FRCFIL: OCT     0"

	SETZB	TA,TB
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "%FRCFL:	OCT	"]]
	PUSHJ	PP,LISTIT
	HRRZ	TA,TB
	PUSHJ	PP,LSINC2
	PUSHJ	PP,LCRLF
	ADDI	PC,1
;Put out "ARRBAS: XWD    0,ARRBAS"

	HRRZ	TB,ARRBAS##		; get start of ARRTAB
	MOVEI	TA,1			; relocated
	MOVE	TE,ARRLOC##		; get in core start of ARRTAB
	CAMN	TE,ARRNXT##		; is there any?
	  SETZB	TA,TB			; no - output non-relocated zero
	PUSHJ	PP,PUTDAT		; output
	MOVE	TE,[POINT 7,	[ASCIZ "%ARBAS:	XWD	0,"]]
	PUSHJ	PP,LISTIT		; output junk to listing
	HRRZ	TA,TB			; get into proper AC
	PUSHJ	PP,LSINC2		; output RH
	PUSHJ	PP,LCRLF		; and a <CR>
	ADDI	PC,1			; bump the PC


;Put out "STKLST: XWD     0,.STLST"

	SETZB	TA,TB			; start with zero
	SKIPN	TB,.STLST##		; do we have a list?
	  JRST	.+3			; no - output non-reloacted zero
	ADD	TB,OTFBAS		; yes - relocate by OTFBAS
	MOVEI	TA,1			; relocate thusly too
	PUSHJ	PP,PUTDAT		; output
	MOVE	TE,[POINT 7,	[ASCIZ "%STLST:	XWD	0,"]]
	PUSHJ	PP,LISTIT		; output to listing
	HRRZ	TA,TB			; get into proper AC
	PUSHJ	PP,LSINC2		; output data to listing
	PUSHJ	PP,LCRLF		; formatting touches
	ADDI	PC,1			; bump the PC
	POPJ	PP,

;INITIALIZE THE PHASE

INITAL:	MOVE	TA,NONRES	;SET HILOC
	ADD	TA,EAS3PC##	; [261] adjust HILOC to be correct
	ADDM	TA,HILOC

	HRRZS	OBJSIZ

	MOVE	TA,BINBUF	;SET UP BINARY OUTPUT BUFFERS
	MOVEM	TA,.JBFF##
	SKIPE	BINDEV
	OUTBUF	BIN,2
	PUSHJ	PP,HDROUT

	PUSHJ	PP,ENTBLK	;PUT OUT ENTRY BLOCK AT START OF REL FILE

	MOVEI	TA,1		;INIT BLKTYP
	MOVEM	TA,BLKTYP
	PUSHJ	PP,PDATI	;SET UP DATGRP
	PUSHJ	PP,PSYMI	;SET UP SYMGRP

	MOVE	CH,[XWD 6,2]	;PUT OUT NAME BLOCK
	PUSHJ	PP,PUTBIN
	MOVEI	CH,0		;ZERO
	PUSHJ	PP,PUTBIN	;  RELOCATION WORD
	MOVE	TC,PRGID	;PROGRAM-ID
	PUSHJ	PP,RADX50	;  IN
	PUSHJ	PP,PUTBIN	;  RADIX 50
	MOVSI	CH,0		;"I AM UNKNOWN" CODE
	TSWT	FREENT;
	HRRI	CH,COMSIZ
	PUSHJ	PP,PUTBIN

	TSWT	FREENT		;RE-ENTRANT CODE?
	JRST	INITL2

	MOVE	CH,[XWD 3,1]	;YES--
	PUSHJ	PP,PUTBIN	;  PUT
	MOVSI	CH,3B19		;  OUT
	PUSHJ	PP,PUTBIN	;  'HISEG'
	MOVE	CH,EAS2PC	;  BLOCK
	ADD	CH,RESDNT
	ADD	CH,EXTCNT
	MOVSS	CH
	HRRI	CH,1B18
	PUSHJ	PP,PUTBIN
;PUT OUT .JBOPS WORD IF THIS IS A MAIN PROGRAM.

INITL2:	MOVE	CH,[XWD 1,2]
	PUSHJ	PP,PUTBIN
	TSWT	FREENT
	TDCA	CH,CH
	MOVSI	CH,(1B2)
	PUSHJ	PP,PUTBIN
	MOVEI	CH,.JBOPS
	PUSHJ	PP,PUTBIN
	TSWT	FREENT
	SKIPA	CH,[XWD 140,FIXNUM+140]
	MOVEI	CH,0
	PUSHJ	PP,PUTBIN

;PUT OUT A REFERENCE TO "FUNCT." IN CASE LINK-10 OVERLAYS ARE GOING
; TO BE USED.

;THIS WILL ONLY BE DONE FOR NON-REENTRANT MAIN PROGRAMS.

;CODE TO BE GENERATED IS:
;	XWD	2,2
;	EXP	0
;	RADIX50	04,FUNCT.
;	EXP	%FUNCT+FIXNUM+140

;AT RESET TIME LIBOL WILL PLACE "JRST FUNCT." IN SOME ABSOLUTE LOCATION
; WHICH IS IN LIBOL'S DISPATCH TABLE.  THUS, WHEN THE OVERLAY ROUTINES
; DO PUSHJ'S TO FUNCT. THEY WILL GO THROUGH THE FUNCT. DEFINED IN THE
; COBOL PROGRAM TO THE FUNCT. DEFINED IN LIBOL.

	TSWF	FREENT		;ARE WE GENERATING REENTRANT CODE?
	JRST	INITL3		;YES, DO NOTHING.

;GET HERE IF WE ARE GENERATING A ONE SEGMENT MAIN PROGRAM.

	MOVE	CH,[XWD	2,2]	;BLOCK TYPE 2(SYMBOLS),,TWO DATA WORDS.
	PUSHJ	PP,PUTBIN	;PUT IT IN THE REL FILE.
	SETZI	CH,		;NO RELOCATION.
	PUSHJ	PP,PUTBIN	;PUT IT IN THE REL FILE.
	MOVE	CH,[RADIX50	04,FUNCT.]	;GLOBAL DEFINITION.
	PUSHJ	PP,PUTBIN	;PUT IT IN THE REL FILE.
	HRRZI	CH,%FUNCT##+FIXNUM+140	;ABSOLUTE LOCATION AT RUNTIME.
	PUSHJ	PP,PUTBIN	;PUT IT IN THE REL FILE.

INITL3:	BLOCK	0
;FINISH UP INITIALIZATION

	MOVEI	TA,(SIXBIT "AS1") ;SET UP FOR AS1FIL
	HRRM	TA,ASYFIL

	HLLZS	SW		;CLEAR SWITCHES
	IFE DEBUG,<SWON	FASDAT;		;TURN ON "DATA AREA">

	PUSHJ	PP,HDROUT	;PUT OUT HEADING LINE
	MOVE	TA,RESDNT	;RESET CURRENT RELOCATION
	MOVEM	TA,CURREL

	HRRZ	TA,EXTLOC	;SET EXTERNAL LOCATIONS TO -1
	ADDI	TA,1
	MOVE	TB,EXTNXT
INITL4:	HLLOS	1(TA)
	ADDI	TA,2
	HLRZ	TC,-1(TA)	;GET COUNT OF EXTRA WORDS
	ANDI	TC,7
	HRLI	TC,(TC)
	ADD	TA,TC		;ADD TO CTR-PTR
	CAIG	TA,(TB)
	JRST	INITL4

	SETOM	TAGOUT		;SET TAGOUT TO -1

INITL9:	SWON	FRELOC;
	SETZB	PC,DATGRP+2
	PUSHJ	PP,FIXED
	JRST	CLRDAT	
;PUT OUT EXTERNAL REQUESTS TO ALL ITEMS IN EXTAB WHICH HAVE BEEN USED.
;SET UP XWD'S FOR THOSE ITEMS USED BY NON-RESIDENT SEGMENTS.

EXTOUT:	MOVE	OP,EXTLOC	;START AT TOP OF TABLE
	TSWT	FREENT;
	ADD	OP,[XWD NUMEXT,NUMEXT]
	PUSHJ	PP,CLRDAT	;INSURE DATGRP IS CLEAN
	HRRZM	PC,DATGRP+2	;SET LOCATION IN DATGRP

EXTO1:	CAMN	OP,EXTNXT	;DONE?
	JRST	EXTO9		;YES--EMPTY SYMGRP AND RETURN

	AOBJP	OP,EXTBAD	;NO--STEP UP TO NEXT ENTRY

	SKIPL	TB,1(OP)	;IS IT REFERENCED IN NON-RESIDENT SEGMENT?
	JRST	EXTO7		;NO

;AN XWD IS REQUIRED

	HRRZS	TB		;YES--CLEAR LEFT HALF
	CAIE	TB,-1		;HAS IT BEEN REFERENCED YET?
	JRST	EXTO2

	SETZB	TB,TA		;NO--USE UNRELOCATED ZERO
	JRST	EXTO3

EXTO2:	MOVEI	TA,1		;YES--RELOCATE
EXTO3:	HRRM	PC,1(OP)	;RESET EXTAB

	PUSHJ	PP,PUTDAT
	PUSHJ	PP,CLRDAT	;INSURE THAT IT'S OUT BEFORE EXTERNAL REQUEST

	TSWF	FNOLST		;ANY OBJECT LISTING?
	JRST	EXTO6		;NO

	PUSHJ	PP,LSTCOD	;YES--LIST PC AND ASSEMBLED CODE

;PUT OUT EXTERNAL REQUESTS  (CONT'D).

	MOVE	TE,[POINT 7,[ASCIZ "XWD	0,"]]
	PUSHJ	PP,LSTMES
	MOVE	DT,OP
	PUSHJ	PP,LSTNAM	;PRINT EXTERNAL NAME
	PUSHJ	PP,LCRLF

EXTO6:	ADDI	PC,1		;BUMP PROGRAM COUNTER

EXTO7:	AOBJP	OP,EXTBAD	;STEP UP TO SECOND WORD

	HRRZ	TA,0(OP)	;ANY REFERENCE TO IT?
	CAIN	TA,-1
	JRST	EXTO8		;NO

	HLRZ	TC,-1(OP)
	ANDI	TC,77777
	ADD	TC,NAMLOC
	MOVE	TC,1(TC)

	PUSHJ	PP,RADX50
	LDB	TB,[POINT 2,(OP),3]	;ENTRY POINT?
	SKIPE	TB
	TLOA	CH,040000	;YES, GLOBAL DEFINITION
	TLO	CH,600000	;NO, GLOBAL REQUEST
	PUSHJ	PP,PUTSYM

EXTO8:	HLRZ	TC,(OP)		;GET # OF EXTRA WORDS
	ANDI	TC,7
	HRLI	TC,(TC)
	ADD	OP,TC		;ADD TO CTR-PTR
	JRST	EXTO1

EXTO9:	MOVEM	PC,HPLOC
	JRST	CLRSYM


;EXTAB IS IMPROPERLY SET UP

EXTBAD:	TTCALL	3,[ASCIZ "EXTNXT IMPROPERLY SET UP
"]
	JRST	KILL
;PUT OUT ENTRY BLOCK AT START OF REL FILE

ENTBLK:	SKIPN	BINDEV		;ANY REL OUTPUT?
	POPJ	PP,		;NO

	HRRZ	OP,EXTLOC	;SET UP EXTAB PTR
	ADDI	OP,3

	PUSHJ	PP,CLREN2	;SET UP DATGRP

ENTBL1:	LDB	TA,[POINT 2,1(OP),3]	;ENTRY POINT?
	JUMPE	TA,ENTBL2	;NO

	HLRZ	TC,(OP)		;GET NAMTAB LINK
	ANDI	TC,77777
	ADD	TC,NAMLOC
	MOVE	TC,1(TC)	;GET SYMBOL
	PUSHJ	PP,RADX50	;CONVERT TO RADIX50

	MOVEM	CH,(GP)		;STASH SYMBOL IN DATGRP
	AOS	DATGRP
	AOBJN	GP,ENTBL2	;FILLED DATGRP?

	PUSHJ	PP,CLRENT	;YES, OUTPUT BLOCK

ENTBL0:	HRLZI	TE,4		;SET UP ENTRY BLOCK TYPE CODE
	MOVEM	TE,DATGRP
	SETZM	TE,DATGRP+1	;CLR RELOCATION WORD
	MOVE	GP,[-^D18,,DATGRP+2]	;SET UP DATGRP PTR

ENTBL2:	HLRZ	TC,1(OP)		;GET COUNT OF EXTRA WORDS
	ANDI	TC,7
	ADDI	OP,2(TC)	;BUMP EXTAB PTR
	MOVE	TC,EXTNXT##	;AT END OF TABLE?
	CAIG	OP,(TC)
	JRST	ENTBL1		;NO

CLRENT:	HRRZ	TE,DATGRP	;GET BLOCK COUNT
	SKIPN	TE		;EXIT IF NONE THERE
	POPJ	PP,

	MOVNI	TE,2(TE)
	HRLI	TE,(TE)
	HRRI	TE,DATGRP

CLREN1:	MOVE	CH,(TE)
	PUSHJ	PP,PUTBIN
	AOBJN	TE,CLREN1

CLREN2:	HRLZI	TE,4		;SET UP ENTRY BLOCK TYPE CODE
	MOVEM	TE,DATGRP
	SETZM	TE,DATGRP+1	;CLR RELOCATION WORD
	MOVE	GP,[-^D18,,DATGRP+2]	;SET UP DATGRP PTR
	POPJ	PP,
;PUT OUT END BLOCK.

;REENTRANT PROGRAMS HAVE HIGH-BREAK FOLLOWED BY LOW-BREAK.
;NON-REENTRANT PROGRAMS HAVE LOW-BREAK FOLLOWED BY ABSOLUTE BREAK.

ENDBLK:	MOVE	CH,[XWD 5,2]	;BLOCK TYPE AND COUNT
	PUSHJ	PP,PUTBIN

	MOVSI	CH,(4B3)	;RELOCATION IF NON-REENTRANT
	TSWF	FREENT
	TLO	CH,(1B3)	;RELOCATION FOR LOW-BREAK
	PUSHJ	PP,PUTBIN

	TSWF	FREENT		;IF RE-ENTRANT,
	SKIPA	CH,HPLOC	;  USE HIGH-BREAK,
	MOVE	CH,END.PC	;  ELSE USE LOW-BREAK
	PUSHJ	PP,PUTBIN

	TSWF	FREENT		;IF RE-ENTRANT
	SKIPA	CH,END.PC	;  USE LOW-BREAK,
	MOVEI	CH,COMSIZ+140	;  ELSE USE COMMON BREAK
	JRST	PUTBIN
;LIST AN INSTRUCTION SET UP BY INITIALIZER

LISTIT:	TSWF	FNOLST;
	POPJ	PP,

	PUSH	PP,TE
	PUSHJ	PP,LSTCOD
	POP	PP,TE

	ILDB	CH,TE		;REPLACE TAB IN LINE WITH
	DPB	CH,LSTBH+1	;  FIRST CHARACTER OF TEXT

	JRST	LSTMES
;SET UP FOR OVERLAY OUTPUT FILE

SETOVR:	POPJ	PP,		;NO--FORGET IT

;FINAL SUMMARY FOR COMPILATION

;PRINT OUT TIMES FOR PHASES

	IFN DEBUG, <EXTERNAL %ATIME,%GTIME,TOPLOC,IMPURE,FREESP
EXTERNAL NAMCT1,NAMCT2,NAMCT3,NAMDIS,DISTSZ,%TTIME,%RTIME,%RGTIM,%RATIM

SUMARY:	TSWF	FNOLST		;ANY LISTING?
	POPJ	PP,		;NO--QUIT
	MOVEI	TA,0
	RUNTIM	TA,
	MOVEM	TA,%RGTIM+1
	MSTIME	CP,
	MOVEM	CP,%GTIME+1
	SETZM	PAGCNT
	PUSHJ	PP,HDROUT
	MOVE	TE,[POINT 7,[ASCIZ "Checkout Summary

       Elapsed       CPU
"]]
	PUSHJ	PP,LSTMES

	MOVEI	TA,%ATIME
	MOVEI	TB,"A"
	SETZM	%TTIME
	SETZM	%RTIME

TIMLUP:	MOVE	CH,TB		;PUT OUT PHASE IDENTIFICATION
	PUSHJ	PP,PUTLST
	ADDI	TB,1
	MOVEI	CH," "
	PUSHJ	PP,PUTLST
	PUSHJ	PP,PUTLST

	MOVE	TE,1(TA)	;COMPUTE RUN TIME
	SUB	TE,0(TA)
	ADDM	TE,%TTIME	;KEEP A RUNNING TOTAL
	PUSHJ	PP,TIMOUT	;PRINT IT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST
	MOVE	TE,3(TA)	;COMPUTE CP TIME
	SUB	TE,2(TA)
	ADDM	TE,%RTIME	;ACCUMULATE IT
	PUSHJ	PP,TIMOUT
TIML2:	PUSHJ	PP,LCRLF

TIML3:	ADDI	TA,4
	CAIG	TA,%GTIME	;DONE?
	JRST	TIMLUP		;NO--LOOP
;FINAL SUMMARY FOR COMPILATION  (CONT'D)

;PRINT OUT TIMES FOR PHASES  (CONT'D)


	MOVE	TE,[POINT 7,[ASCIZ "
Total Elapsed"]]
	PUSHJ	PP,LSTMES

	MOVE	TE,CP
	SUB	TE,%ATIME
	PUSHJ	PP,TIMOUT
	MOVE	TE,[POINT 7,[ASCIZ ", not including GETSEG"]]
	PUSHJ	PP,LSTMES
	MOVE	TE,%TTIME
	PUSHJ	PP,TIMOUT

	MOVE	TE,[POINT 7,[ASCIZ ", CPU time"]]
	PUSHJ	PP,LSTMES
	MOVE	TE,%RTIME
	PUSHJ	PP,TIMOUT
	PUSHJ	PP,LCRLF
;FINAL SUMMARY FOR COMPILATION  (CONT'D)

;PRINT OUT SIZE OF IMPURE AREA

TABDEB:	MOVE	TE,[POINT 7,[ASCIZ "

Impure size:	"]]
	PUSHJ	PP,LSTMES

	HRRZ	TE,TOPLOC
	SUBI	TE,IMPURE-140
	PUSHJ	PP,TABD2
	MOVE	TE,[POINT 7,[ASCIZ "
Free Storage:	"]]
	PUSHJ	PP,LSTMES

	HLRZ	TE,FREESP
	PUSHJ	PP,TABD2
;FINAL SUMMARY FOR COMPILATION  (CONT'D)

;PRINT OUT TABLE USAGE.

	MOVE	TE,[POINT 7,[ASCIZ "

	  Orig   Final  Used

"]]
	PUSHJ	PP,LSTMES

	MOVE	TB,TABDX

TABD1:	MOVE	TA,(TB)		;PICK UP TABLE NAME
	PUSHJ	PP,SIXOUT	;PRINT IT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST

	HLRZ	TE,1(TB)	;PRINT ORIGINAL SIZE
	CAIN	TE,1		;IF 1, REALLY ZERO
	MOVEI	TE,0
	PUSH	PP,TE		;SAVE IT
	PUSHJ	PP,TABD2

	MOVE	TC,1(TB)	;PRINT FINAL SIZE
	HLRE	TE,(TC)
	MOVMS	TE
	MOVEI	CH," "
	PUSHJ	PP,PUTLST
	POP	PP,TD		;SAME SIZE AS ORIGINAL?
	CAMN	TE,TD
	PUSHJ	PP,TABD6	;YES--PRINT SPACES AND SKIP
	PUSHJ	PP,TABD2

	HRRZ	TE,1(TC)	;PRINT SIZE USED (MNE'NXT - MNE'LOC)
	HRRZ	TD,0(TC)
	SUB	TE,TD
	MOVEI	CH," "
	PUSHJ	PP,PUTLST
	PUSHJ	PP,TABD2

	PUSHJ	PP,LCRLF
	ADDI	TB,1
	AOBJN	TB,TABD1	;LOOP UNTIL DONE
;FINAL SUMMARY FOR COMPILATION  (CONT'D)

;PRINT OUT NAMTAB PARAMETERS AND BASE LOCATIONS

	PUSHJ	PP,LCRLF
	PUSHJ	PP,LCRLF
	REPEAT 0,<
	MOVE	TE,[POINT 7,[ASCIZ "
SEARCH DISTRIBUTION

"]]
	PUSHJ	PP,LSTMES

	MOVEI	TA,1

NAMCTB:	MOVEI	CH," "
	CAIN	TA,DISTSZ
	MOVEI	CH,76		;"GREATER THAN"
	PUSHJ	PP,PUTLST

	MOVEI	TE,(TA)
	CAIN	TE,DISTSZ
	SUBI	TE,1
	PUSHJ	PP,DECIT

	MOVEI	CH,"-"
	PUSHJ	PP,PUTLST

	MOVE	TE,NAMDIS-1(TA)
	PUSHJ	PP,DECIT
	PUSHJ	PP,LCRLF

	CAIE	TA,DISTSZ
	AOJA	TA,NAMCTB

	>

	JRST	BASLS0
;FINAL SUMMARY FOR COMPILATION  (CONT'D).

	DEFINE BASES,<
	XLIST
	BASLOC	NAMCT1,1
	BASLOC	NAMCT2,1
	BASLOC	NAMCT3,1
	BASLOC	DATBAS,0
	BASLOC	ARRBAS,0
	BASLOC	OTFBAS,0
	BASLOC	ICHBAS,0
	BASLOC	OCHBAS,0
	BASLOC	FTBBAS,0
	BASLOC	RESDNT,0
	BASLOC	NONRES,0
	BASLOC	LITBAS,0
	BASLOC	TEMBAS,0
	LIST>
	DEFINE BASLOC (X,Y),<
	XWD	Y*40,X
	SIXBIT	"X"
	>
BASLST:	BASES;
BASXWD:	XWD	<BASLST-.>/2,BASLST

BASLS0:	PUSHJ	PP,LCRLF
	MOVE	TB,BASXWD

BASLS1:	MOVE	TA,1(TB)
	PUSHJ	PP,SIXOUT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST

	MOVE	TE,@0(TB)
	MOVE	TA,0(TB)
	TLNE	TA,-40
	JRST	BASLS4

	MOVE	TA,[POINT 3,TE,17]

BASLS2:	ILDB	CH,TA
	ADDI	CH,"0"
	PUSHJ	PP,PUTLST
	TLNE	TA,770000
	JRST	BASLS2

BASLS3:	PUSHJ	PP,LCRLF
	ADDI	TB,1
	AOBJN	TB,BASLS1

	POPJ	PP,

BASLS4:	PUSHJ	PP,DECIT
	JRST	BASLS3
;FINAL SUMMARY FOR COMPILATION  (CONT'D)
;PRINT OUT TABLE USAGE  (CONT'D)

TABD2:	MOVEI	CT,SIZED
	IDIVI	TE,12		;CONVERT TO 5 DECIMAL DIGITS
	PUSH	PP,TD
	SOJG	CT,.-2

	MOVEI	CT,SIZED-1
	JUMPE	TE,.+4		;MORE THAN 5 DIGITS?
	IDIVI	TE,12		;YES--KEEP CONVERTING
	PUSH	PP,TD
	AOJA	CT,.-3

	MOVEI	CH," "
	PUSHJ	PP,PUTLST

TABD3:	POP	PP,TE		;SUPPRESS LEADING ZEROES
	JUMPN	TE,TABD5
	PUSHJ	PP,PUTLST
	SOJG	CT,TABD3

TABD4:	POP	PP,TE		;PRINT OUT SIGNIFICANT DIGITS
TABD5:	MOVEI	CH,"0"(TE)
	PUSHJ	PP,PUTLST
	SOJGE	CT,TABD4
	POPJ	PP,


;PRINT OUT SIX SPACES AND SKIP UPON EXITING

TABD6:	AOS	(PP)
	MOVEI	CT,SIZED+1
	MOVEI	CH," "
	PUSHJ	PP,PUTLST
	SOJG	CT,.-1
	POPJ	PP,
;FINAL SUMMARY FOR COMPILATION  (CONT'D)

;PRINT ELAPSED TIME
;ENTER WITH TIME IN "TE".

TIMOUT:	ADDI	TE,5		;ROUND UP 5 MILS
	IDIVI	TE,^D1000	;CONVERT TO SECONDS
	MOVEI	TC,(TD)	;SAVE REMAINDER ROUNDED
	PUSHJ	PP,TABD2	;PRINT SECONDS

TIMO2:	MOVEI	CH,"."		;PRINT FRACTIONS OF A SECOND
	PUSHJ	PP,PUTLST

	MOVE	TE,TC
	IDIVI	TE,^D100
	MOVEI	CH,"0"(TE)
	PUSHJ	PP,PUTLST

	MOVE	TE,TD
	IDIVI	TE,^D10
	MOVEI	CH,"0"(TE)
	JRST	PUTLST
;FINAL SUMMARY FOR COMPILATION (CONT'D)

;TABLE OF TABLES

	DEFINE TABSET (A,B,C,E,F,G),<
	EXTERNAL A'LOC
	SIXBIT "E"
	XWD	^D'B+1,A'LOC>

TABDT:	TABLES
TABDX:	XWD	<TABDT-.>/2,TABDT

	>			;END OF "IFN DEBUG" FOR SUMMARY
;PRODUCE CREF LISTING

IFE	CREF,<XLIST>

IFN	CREF,<

CREFL:	MOVSI	TE,(ASCIZ "C")
	MOVEM	TE,HDRPAG
	SETZM	SUBPAG
	SETZM	PAGCNT

	MOVEM	PP,CRFERA##
	MOVE	TA,CRFBUF
	MOVEM	TA,.JBFF##
	INBUF	CRF,2

	MOVE	TD,CRFHDR
	MOVE	TC,CRFHDR+1
	SETZB	TB,TA
	LOOKUP	CRF,TD
	JRST	KNOCRF

	PUSHJ	PP,PSORT	;SET UP SORT

CREF04:	MOVE	TE,[XWD -6,GCREFN-1]
CREF4A:	PUSHJ	PP,GETCRF	;GET CREF WORD
	JRST	CREF10		;NO MORE, GO DO MERGE

	AOBJP	TE,CREF05
	TLC	CH,1B18
	MOVEM	CH,(TE)
	JRST	CREF4A

CREF05:	TLZ	CH,377774	;GET RID OF SOME CRUD
	TLC	CH,1B18		;REVERSE 'DEFINITION' FLAG SO THAT DEFINITION
				;  OF ITEM SORTS BEFORE NON-DEFINITION
	ROT	CH,^D11		;GET LINE LUMBER INTO LEFT HALF
	MOVEM	CH,(TE)

	LDB	TE,[POINT 6,GCREFN,5];IF IT DOESN'T START WITH "-"
	CAIE	TE,"M"-40	;  (SIXBIT "-" WITH HI-BIT COMPLEMENTED)
	PUSHJ	PP,RELES	;  GIVE ITEM TO SORT
	JRST	CREF04		;GO AFTER ANOTHER
;PRODUCE CREF LISTING (CONT'D)

;END OF INPUT

CREF10:	PUSHJ	PP,MERGE	;MERGE THE SCRATCH FILES

	SETZM	OLDCNM		;CLEAR 'MOST RECENT NAME'
	MOVE	TE,[XWD OLDCNM,OLDCNM+1]
	BLT	TE,OLDCNM+4

	PUSHJ	PP,HDROUT	;PUT OUT HEADING

CREF30:	PUSHJ	PP,RETRN	;GET AN ITEM FROM SORT
	JRST	LCRLF		;AT END--PUT OUT <C.R.>,<L.F.> AND RETURN

CRF30A:	MOVE	TE,[XWD -5,GCREFN];TURN
	MOVSI	TD,1B18		;  OFF
CREF31:	XORM	TD,(TE)		;  SIGN
	AOBJN	TE,CREF31	;  BIT

	MOVE	TE,[XWD -5,GCREFN]; COMPARE
	MOVEI	TD,OLDCNM	;  THIS
CRF31A:	MOVE	TC,(TE)		;  ONE
	CAME	TC,(TD)		;  WITH
	JRST	CRF31B		;  LAST
	AOBJP	TE,CREF34	;  0NE
	AOJA	TD,CRF31A	;  *

;NEW ONE IS NOT SAME AS OLD ONE

CRF31B:	PUSHJ	PP,LCRLF	;PUT OUT <C.R.>,<L.F.>
	MOVE	TE,[XWD GCREFN,OLDCNM];COPY NEW ONE TO
	BLT	TE,OLDCNM+4	;  OLD ONE

	MOVEI	TE,0		;PUT
	MOVE	TA,[POINT 6,GCREFN]; NEW
CRF31C:	ILDB	CH,TA		;  ONE
	JUMPE	CH,CRF31D	;  ONTO
	ADDI	CH,40		;  LISTING
	PUSHJ	PP,PUTLST	;  FILE
	AOJA	TE,CRF31C	;  *

CRF31D:	TRZ	TE,7		;TAB
CRF31E:	MOVEI	CH,11		;  TO
	PUSHJ	PP,PUTLST	;  COLUMN
	ADDI	TE,10		;  32
	CAIGE	TE,40		;  *
	JRST	CRF31E		;  *
;PRODUCE CREF LISTING (CONT'D)

	MOVEI	TE,^D11		;SET UP
	TSWF	FLTTY		;  COUNT OF
	MOVEI	TE,^D5		;  NUMBERS PER
	MOVEM	TE,GCREFC	;  LINE
	JRST	CREF36

CREF34:	SOSLE	GCREFC		;IS LINE FULL?
	JRST	CREF35		;NO
	PUSHJ	PP,LCRLF	;YES--PUT OUT <C.R.>,<L.F.>
	MOVEI	CH,11		;PUT OUT
	PUSHJ	PP,PUTLST	;  TABS
	PUSHJ	PP,PUTLST	;  TO
	PUSHJ	PP,PUTLST	;  COLUMN 24

	MOVEI	TE,^D11		;SET UP
	TSWF	FLTTY		;  COUNT OF
	MOVEI	TE,^D5		;  NUMBERS PER
	MOVEM	TE,GCREFC	;  LINE
;PRODUCE CREF LISTING (CONT'D)

;PUT OUT LINE NUMBER

CREF35:	MOVEI	CH,11		;PRECEDE IT
	PUSHJ	PP,PUTLST	;  BY TAB

CREF36:	HLRZ	TC,GCREFN+5	;GET LINE NUMBER
	MOVEI	TD,4		;PUT OUT 4 DIGITS

	PUSHJ	PP,CREF38

	MOVE	TA,GCREFN+5	;IS IT A
	TROE	TA,1B25		;  DEFINITION?
	JRST	CREF30		;NO

	PUSH	PP,TA		;YES--SAVE TA
	MOVEI	CH,"#"		;PRINT A
	PUSHJ	PP,PUTLST	;  POUND SIGN

	PUSHJ	PP,RETRN	;GET NEXT ITEM
	JRST	CREF37		;NO MORE--WE ARE DONE

	POP	PP,TA		;GET PREVIOUS LN,CP
	CAMN	TA,GCREFN+5	;IF SAME AS THIS ONE,
	JRST	CREF30		;  IGNORE THIS ONE,
	JRST	CRF30A		;  ELSE USE THIS ONE

CREF37:	POP	PP,TA		;RESTORE PUSH-DOWN LIST
	JRST	LCRLF		;PUT OUT <C.R.>,<L.F.> AND LEAVE


;PUT OUT 4-DIGIT DECIMAL NUMBER

CREF38:	IDIVI	TC,^D10
	HRLM	TB,(PP)
	SOJLE	TD,.+2
	PUSHJ	PP,CREF38

	HLRZ	CH,(PP)
	ADDI	CH,"0"
	JRST	PUTLST
;GET WORD FROM CREF FILE

GETCRF:	SOSG	CRFBHI+2
	JRST	GTCRF2
GTCRF1:	ILDB	CH,CRFBHI+1
	AOS	(PP)
	POPJ	PP,

GTCRF2:	IN	CRF,
	JRST	GTCRF1
	STATO	CRF,740000	;IF NO ERROR BITS,
	POPJ	PP,		;  IT MUST BE END OF FILE

	MOVEI	CH,CRFDEV
	JRST	DEVDED


;NO CREF FILE

KNOCRF:	TTCALL	3,[ASCIZ "?COULDN'T FIND CREF FILE"]
	EXIT

	>			; IFN CREF

	LIST

;TABLE OF ROUTINES TO CREATE ADDRESS, BY ADDRESS TYPE

ADRTB1:	JRST	ADRCON		;CONSTANT
	PUSHJ	PP,ADRDAT	;ICHTAB
	PUSHJ	PP,ADRPRO	;PROTAB
	JRST	ADREXT		;EXTAB
	PUSHJ	PP,ADRFIL	;FTBTAB
	PUSHJ	PP,ADRTAG	;OCHTAB
	JRST	INCCON		;INCREMENT IS A CONSTANT
	JRST	INCMIS		;INCREMENT IS MISCELLANEOUS

;TABLE OF ROUTINES TO HANDLE INCREMENT,BY INCREMENT TYPE

INCTB1:	PUSHJ	PP,BADINC	;ADD INCREMENT TO ADDRESS
	HRR	TB,OTFBAS	;ADD TO OTFBAS
	HRR	TB,OCHBAS	;ADD TO BAS OF OCHTAB
	HRR	TB,LITBAS	;ADD TO LITERAL POOL BASE
	HRR	TB,ICHBAS	;ADD TO BASE OF ICHTAB
	HRR	TB,PC		;ADD TO CURRENT LOCATION
	PUSHJ	PP,TMPINC	;ADD TO TEMPORARY BASE
	HRR	TB,DATBAS	;ADD TO BASE OF DATA

;TABLE OF ROUTINES USED TO LIST THE ADDRESS

ADRTB2:	JRST	LSCON1		;ADDRESS IS CONSTANT <100000
	ADD	DT,ICHLOC	;ICHTAB
	ADD	DT,PROLOC	;PROTAB
	JRST	LSTEXT		;EXTAB
	JRST	LSTFTB		;FTBTAB
	ADD	DT,OCHLOC##	;OCHTAB
	JRST	LSTCON		;INCREMENT IS CONSTANT >77777
	JRST	LSTMIS		;MISCELLANEOUS

;TABLE OF ROUTINES FOR LISTING MISCELLANEOUS ADDRESSES

INCTB2:	MOVSI	TA," "-40	;NOT USED
	MOVE	TA,[SIXBIT "%OTF"]
	MOVE	TA,[SIXBIT "%OCH"]
	MOVE	TA,[SIXBIT "%LIT"]
	MOVE	TA,[SIXBIT "%ICH"]
	MOVSI	TA,160000
	PUSHJ	PP,TMPLST
	MOVE	TA,[SIXBIT "%DAT"]
;TABLE OF ROUTINES WHICH LIST CONSTANTS

CONTAB:	EXP	LSTD1
	EXP	LSTD2
	EXP	LSTFLT
	EXP	LSTOCT

;TABLE TO AID IN PUTTING OUT 'GETSEG' ROUTINE

GETTAB:	SIXBIT	"SYS"
	POINT	7,[ASCIZ /%RPGLB:	SIXBIT	"SYS"/]
	%LB6
	%LB7
IFN	%CPU-%20,<
	SIXBIT	"SHR"
	POINT	7,[ASCIZ /	SIXBIT	"SHR"/]
	>
IFE	%CPU-%20,<
	SIXBIT	"EXE"
	POINT	7,[ASCIZ /	SIXBIT	"EXE"/]
	>
	Z
	POINT	7,[ASCIZ /	Z/]
	Z
	POINT	7,[ASCIZ /	Z/]
	Z
	POINT	7,[ASCIZ /	Z/]
;TABLE OF POWERS OF TEN FOR FLOATING-POINT CONVERSION.
;THE FIRST PARAMETER IS THE EXPONENT, THE SECOND IS THE HI-ORDER 35 BITS
;OF THE MANTISSA, AND THE THIRD IS THE LOW-ORDER 35 BITS OF THE MANTISSA.

;ONLY THE HI-ORDER 35 BITS ARE USED IN THE CONVERSION.

DEFINE .TAB. (A)<
	REPEAT 0,<
	NUMBER 732,357347511265,056017357445	;D-50
	NUMBER 736,225520615661,074611525567
	NUMBER 741,273044761235,213754053125
	NUMBER 744,351656155504,356747065752
	NUMBER 750,222114704413,025260341562
	NUMBER 753,266540065515,332534432117
	NUMBER 756,344270103041,121263540543
	NUMBER 762,216563051724,322660234335
	NUMBER 765,262317664312,007434303425
	NUMBER 770,337003641374,211343364332
	NUMBER 774,213302304735,325716130610	;D-40
	NUMBER 777,256162766125,113301556752
	>
	NUMBER 002,331617563552,236162112545	;D-38
	NUMBER 006,210071650242,242707256537
	NUMBER 011,252110222313,113471132267
	NUMBER 014,324532266776,036407360745
	NUMBER 020,204730362276,323044526457
	NUMBER 023,246116456756,207655654173
	NUMBER 026,317542172552,051631227231
	NUMBER 032,201635314542,132077636440
	NUMBER 035,242204577672,360517606150	;D-30
	NUMBER 040,312645737651,254643547602
	NUMBER 043,375417327624,030014501542
	NUMBER 047,236351506674,217007711035
	NUMBER 052,306044030453,262611673245
	NUMBER 055,367455036566,237354252116
	NUMBER 061,232574123152,043523552261
	NUMBER 064,301333150004,254450504735
	NUMBER 067,361622002005,327562626124
	NUMBER 073,227073201203,246647575664
	NUMBER 076,274712041444,220421535242	;D-20
	NUMBER 101,354074451755,264526064512
	NUMBER 105,223445672164,220725640716
	NUMBER 110,270357250621,265113211102
	NUMBER 113,346453122766,042336053323
	NUMBER 117,220072763671,325412633103
	NUMBER 122,264111560650,112715401724
	NUMBER 125,341134115022,135500702312
	NUMBER 131,214571460113,172410431376
	NUMBER 134,257727774136,131112537675
	NUMBER 137,333715773165,357335267655	;D-10
	NUMBER 143,211340575011,265512262714
	NUMBER 146,253630734214,043034737477
	NUMBER 151,326577123257,053644127417
	NUMBER 155,206157364055,173306466551
	NUMBER 160,247613261070,332170204303
	NUMBER 163,321556135307,020626245364
	NUMBER 167,203044672274,152375747331
	NUMBER 172,243656050753,205075341217
	NUMBER 175,314631463146,146314631463	;D-01
A:	NUMBER 201,200000000000,0	;D00
	NUMBER 204,240000000000,0
	NUMBER 207,310000000000,0
	NUMBER 212,372000000000,0
	NUMBER 216,234200000000,0
	NUMBER 221,303240000000,0
	NUMBER 224,364110000000,0
	NUMBER 230,230455000000,0
	NUMBER 233,276570200000,0
	NUMBER 236,356326240000,0
	NUMBER 242,225005744000,0	;D+10
	NUMBER 245,272207335000,0
	NUMBER 250,350651224200,0
	NUMBER 254,221411634520,0
	NUMBER 257,265714203644,0
	NUMBER 262,343277244615,0
	NUMBER 266,216067446770,040000000000
	NUMBER 271,261505360566,050000000000
	NUMBER 274,336026654723,262000000000
	NUMBER 300,212616214044,117200000000
	NUMBER 303,255361657055,143040000000	;D+20
	NUMBER 306,330656232670,273650000000
	NUMBER 312,207414740623,165311000000
	NUMBER 315,251320130770,122573200000
	NUMBER 320,323604157166,147332040000
	NUMBER 324,204262505412,000510224000
	NUMBER 327,245337226714,200632271000
	NUMBER 332,316627074477,241000747200
	NUMBER 336,201176345707,304500460420
	NUMBER 341,241436037271,265620574524
	NUMBER 344,311745447150,043164733651	;D+30
	NUMBER 347,374336761002,054022122623
	NUMBER 353,235613266501,133413263573
	NUMBER 356,305156144221,262316140531
	NUMBER 361,366411575266,037001570657
	NUMBER 365,232046056261,323301053415
	NUMBER 370,300457471736,110161266320
	NUMBER 373,360573410325,332215544004
	NUMBER 377,226355145205,250330436402	;D+38
	REPEAT 0,<
	NUMBER 402,274050376447,022416546102
	NUMBER 405,353062476160,327122277522	;D+40
	NUMBER 411,222737506706,206363367623
	NUMBER 414,267527430470,050060265567
	NUMBER 417,345455336606,062074343124
	NUMBER 423,217374313163,337245615764
	NUMBER 426,263273376020,327117161361
	NUMBER 431,340152275425,014743015655
	NUMBER 435,214102366355,050055710514
	NUMBER 440,257123064050,162071272637
	NUMBER 443,332747701062,216507551406
	NUMBER 447,210660730537,231114641743	;D+50
	NUMBER 452,253035116667,177340012333
	>
>

DEFINE NUMBER (A,B,C)
<  EXP B>

FLTAB0:	.TAB. FLTAB1

XX==<FLTAB1-FLTAB0>	;CALCULATE NUMBER OF TABLE ENTRIES BEFORE "FLTAB1"
XX==XX-XX/4*4		;CALC XX==XX MOD 4

BINR1==<BINR2==<BINR3==0>>	;INIT THE BINARY

DEFINE NUMBER (A,B,C)<
IFE XX-1,<	BYTE (9) BINR1,BINR2,BINR3,<A>
	BINR1==<BINR2==<BINR3==0>> >
IFE XX-2,<BINR3==A>
IFE XX-3,<BINR2==A>
IFE XX,<BINR1==A
	XX==4>
XX==XX-1>

	POINT 9,FLTAB3-1(TE),17
	POINT 9,FLTAB3-1(TE),26
	POINT 9,FLTAB3-1(TE),35
FLTAB2:	POINT 9,FLTAB3(TE),8
	POINT 9,FLTAB3(TE),17
	POINT 9,FLTAB3(TE),26
	POINT 9,FLTAB3(TE),35

	.TAB. FLTAB3
	IFN BINR1!BINR2!BINR3,<	BYTE (9) BINR1,BINR2,BINR3,0>
;TABLE OF DECIMAL POWERS OF TEN

DECTAB:	DEC	1000000000
	DEC	100000000
	DEC	10000000
	DEC	1000000
	DEC	100000
	DEC	10000
	DEC	1000
	DEC	100
	DEC	10

;TABLE OF  PDP-10 OP-CODES

DEFINE OPCODE (MNEM,OP10,LISTAC,LIST10),<
	XWD	LISTAC*1B18+LIST10,OP10
	SIXBIT	"MNEM">
DEFINE UUOTPX (UUOTYP,UUOSIZ),<
	XWD	UUOTYP,UUOSIZ>
DEFINE TABLE1,<
	XLIST
OPTABL:	OPCODE	MOVE,200,1,0	;000
	OPCODE	MOVEI,201,1,1	;001
	OPCODE	MOVEM,202,1,0	;002
	OPCODE	MOVM,214,1,0	;003
	OPCODE	MOVMM,216,1,0	;004
	OPCODE	MOVN,210,1,0	;005
	OPCODE	MOVNI,211,1,1	;006
	OPCODE	MOVNM,212,1,0	;007
	OPCODE	MOVS,204,1,0	;010
	OPCODE	MOVSI,205,1,1	;011

	OPCODE	ADD,270,1,0	;012
	OPCODE	ADDI,271,1,1	;013
	OPCODE	ADDM,272,1,0	;014
	OPCODE	ADDB,273,1,0	;015
	OPCODE	SUB,274,1,0	;016
	OPCODE	SUBI,275,1,1	;017
	OPCODE	SUBM,276,1,0	;020

	OPCODE	MUL,224,1,0	;021
	OPCODE	MULI,225,1,1	;022
	OPCODE	IMUL,220,1,0	;023
	OPCODE	IMULI,221,1,1	;024
	OPCODE	ASH,240,1,1	;025

	OPCODE	DIV,234,1,0	;026
	OPCODE	TDO,670,1,0	;027
	OPCODE	TDZ,630,1,0	;030
	OPCODE	IDIV,230,1,0	;031
	OPCODE	IDIVI,231,1,1	;032
	OPCODE	IDIVM,232,1,0	;033

	OPCODE	FADR,144,1,0	;034
	OPCODE	FADRM,146,1,0	;035
	OPCODE	FSBR,154,1,0	;036
	OPCODE	FSBRM,156,1,0	;037
	OPCODE	FMPR,164,1,0	;040
	OPCODE	FMPRM,166,1,0	;041
	OPCODE	FDVR,174,1,0	;042
	OPCODE	FDVRM,176,1,0	;043
	OPCODE	DPB,137,1,0	;044
	OPCODE	LDB,135,1,0	;045
	OPCODE	IDPB,136,1,0	;046
	OPCODE	ILDB,134,1	;047

	OPCODE	AOS,350,1,0	;050
	OPCODE	SOS,370,0,0	;051
	OPCODE	SOSGE,375,0,0	;052
	OPCODE	SOSLE,373,0,0	;053

	OPCODE	CAME,312,1,0	;054
	OPCODE	CAIE,302,1,1	;055
	OPCODE	CAMG,317,1,0	;056
	OPCODE	CAIG,307,1,1	;057
	OPCODE	CAMGE,315,1,0	;060
	OPCODE	CAIGE,305,1,1	;061
	OPCODE	CAML,311,1,0	;062
	OPCODE	CAIL,301,1,1	;063
	OPCODE	CAMLE,313,1,0	;064
	OPCODE	CAILE,303,1,1	;065
	OPCODE	CAMN,316,1,0	;066
	OPCODE	CAIN,306,1,1	;067

	OPCODE	JUMPE,322,1,0	;070
	OPCODE	JUMPG,327,1,0	;071
	OPCODE	JUMPGE,325,1,0	;072
	OPCODE	JUMPL,321,1,0	;073
	OPCODE	JUMPLE,323,1,0	;074
	OPCODE	JUMPN,326,1,0	;075

	OPCODE	JRST,254,0,0	;076

	OPCODE	SKIPE,332,0,0	;077
	OPCODE	SKIPG,337,0,0	;100
	OPCODE	SKIPGE,335,0,0	;101
	OPCODE	SKIPL,331,0,0	;102
	OPCODE	SKIPLE,333,0,0	;103
	OPCODE	SKIPN,336,0,0	;104
	OPCODE	SKIPA,334,1,0	;105
	OPCODE	TRNE,602,1,0	;106
	OPCODE	TRNN,606,1,0	;107
	OPCODE	TLNE,603,1,0	;110
	OPCODE	TLNN,607,1,0	;111

	OPCODE	IBP,133,0,0	;112
	OPCODE	PUSHJ,260,1,0	;113

	OPCODE	BLT,251,1,0	;114

	OPCODE	SETZM,402,0,0	;115
	OPCODE	SETOM,476,0,0	;116

	OPCODE	TDCA,654,1,0	;117
	OPCODE	ANDM,406,1,0	;120
	OPCODE	TDNN,616,1,0	;121
	OPCODE	HRLOI,525,1,0	;122
	OPCODE	HRROI,561,1,0	;123
	OPCODE	HRLZI,515,1,0	;124
	OPCODE	HRRZI,551,1,0	;125
	OPCODE	SETZB,403,1,0	;126
	OPCODE	ARG,320,1,0	;127
	OPCODE	SOJG,367,1,0	;130
	OPCODE	EXCH,250,1,0	;131
	OPCODE	CALLI,047,1,0	;132
	OPCODE	TLZ,621,1,0	;133
	OPCODE	TLO,661,1,0	;134
	OPCODE	SETCA,450,1,0	;135
	OPCODE	SETCMM,462,1,0	;136
	OPCODE	POPJ,263,1,0	;137
	OPCODE	SUBSCR,1,1,0	;140
	OPCODE	UUO7,7,1,0	;141
	OPCODE	FIX.,10,1,0	;142
	OPCODE	UUO11,11,1,0	;143
	OPCODE	PERF.,12,1,0	;144
	OPCODE	FLOT.1,13,1,0	;145
	OPCODE	FLOT.2,14,1,0	;146
	OPCODE	PD6.,15,1,0	;147
	OPCODE	PD7.,16,1,0	;150
	OPCODE	GD6.,17,1,0	;151
	OPCODE	GD7.,20,1,0	;152
	OPCODE	NEG.,21,1,0	;153
	OPCODE	MAG.,22,1,0	;154
	OPCODE	ADD.12,23,1,0	;155
	OPCODE	ADD.21,24,1,0	;156
	OPCODE	ADD.22,25,1,0	;157
	OPCODE	SUB.12,26,1,0	;160
	OPCODE	SUB.21,27,1,0	;161
	OPCODE	SUB.22,30,1,0	;162
	OPCODE	MUL.12,31,1,0	;163
	OPCODE	MUL.21,32,1,0	;164
	OPCODE	MUL.22,33,1,0	;165
	OPCODE	DIV.11,34,1,0	;166
	OPCODE	DIV.12,35,1,0	;167
	OPCODE	DIV.21,36,1,0	;170
	OPCODE	DIV.22,37,1,0	;171


UUOTBL:	UUOTPX	UOTP1,UOSZ1		;OPEN,CLOSE
	UUOTPX	UOTP2,UOSZ2		;I/O
	UUOTPX	UOTP3,UOSZ3		;COMPARISON
	UUOTPX	UOTP4,UOSZ4		;CONVERSION
	UUOTPX	UOTP5,UOSZ5		;MISCELLANEOUS

	LIST>
	DEFINE	UUOCOD	(MNEM,OP10),<
	IFIDN <MNEM>,<PERF.>,<EXP 1B0+OP10>
	IFDIF <MNEM>,<PERF.>,<XWD 0,OP10>
	SIXBIT	"MNEM">

	DEFINE	UUOIRP(A,B),<
	IRP	A,<
	UUOCOD	A,B>>

	DEFINE UUOTSZ (A),<
	XXX==<.-UOTP'A>/2
	IFE XXX&1,<UOSZ'A==XXX/2>
	IFN XXX&1,<UOSZ'A==XXX/2+1>
	UUONUM==UUONUM+UOSZ'A
	UUOTNM==UUOTNM+1
	>

	FSTSPC==140		;ASYFIL CODE FOR FIRST UUO
	NUMSPC==32		;NUMBER OF UUO'S WHICH ACCEPT ANY AC-FIELD
	FSTUUO==172	;FIRST UUO WHICH USES AC-FILED TO FURTHER DEFINE OP-CODE
	UUOTNM==0
	UUONUM==NUMSPC
	DEFINE	TABLE2,<
	XLIST
UOTP1:	UUOIRP	<ULOSE.,ULOSE.>,1
	UUOTSZ 1
UOTP2:	UUOIRP	<ULOSE.,ULOSE.,ULOSE.,ULOSE.,ULOSE.,ULOSE.>,2
	UUOIRP <ULOSE.,ULOSE.,ULOSE.>,2
	UUOIRP <ULOSE.,ULOSE.>,2
	UUOTSZ 2
UOTP3:	UUOIRP	<COMP.,CMP.11>,3
	UUOIRP	<CMP.12,CMP.21,CMP.22,CMP.76,CMP.96,CMP.97>,3
	UUOIRP	<SPAC.6,SPAC.7,SPAC.9,COMP%,CMP%11,CMP%12>,3
	UUOIRP	<CMP%21,CMP%22>,3
	UUOTSZ 3
UOTP4:	UUOIRP	<MOVE.,C.D6D7,C.D6D9>,4
	UUOIRP	<C.D7D6,C.D7D9,C.D9D6,C.D9D7>,4
	UUOIRP	<MVSGNR,MVSGN>,4
	UUOIRP	<TESTZ,TIME.,TIMED.,RSVWD.,TESTB.,SQRT.,DEBUG.>,4
	UUOTSZ 4
UOTP5:	UUOIRP	<SETOF.,SETON.,INDC.>,5
	UUOIRP	<FORCE.,EXCPT.,.READ.,CHAIN.>,5
	UUOIRP	<DSPLY.,ULOSE.,ULOSE.,ULOSE.>,5
	UUOIRP	<ULOSE.,ULOSE.,ULOSE.,ULOSE.,ULOSE.>,5
	UUOTSZ 5

	LIST>
	TABLE1
	TABLE2



ASAC:	POINT 4,W1,12	;AC-FIELD OF OPERATOR

	COMSIZ==1600	;SIZE OF COMMON IN OBJECT PROGRAM
	ENDIT==177
	SIZED==5	;SIZE OF LARGEST NUMBER PRINTED AT TABD2

EXTERNAL LNKCOD,TB.FIL
EXTERNAL .JBOPS,COUNTF,COUNTW
EXTERNAL %ES.PC,END.PC
EXTERNAL NAMLOC,DATLOC,FILLOC,FILNXT,PROLOC,EXTLOC,EXTNXT
EXTERNAL LITLOC,TAGOUT,SAVTAG,DATGRP,DECSEG,ASYFIL,NAMNXT,LITBLK
EXTERNAL ASOP,INCTYP,ADRTYP,PTSEGN,RESDNT,NONRES,DATBAS,TEMBAS,USEBAS
EXTERNAL EAS2PC,IMPPAR,LITBAS,OTFBAS,ICHBAS,OCHBAS,INDBAS,FLTC1,FLTC2
EXTERNAL SYMLC1,SYMREL,UUOBIT,CURREL,SYMGRP,LSTBH
EXTERNAL PRGID,PROGST,GHOLD,PAGCNT,GAERAS,NUMEXT,EXTCNT
EXTERNAL BINHDR,BINDEV,BINBUF,BINPP,BINBH,OVRWRD,CURLIT,HILOC,HPLOC
EXTERNAL LSTDEV,CRFDEV,CRFBHI,CRFBUF,CRFHDR
EXTERNAL FTDBAS,FIXEDS,OBJSIZ,HDRPAG,SUBPAG
EXTERNAL GCREFC,GCREFN,OLDCNM,CREFSW,PRODSW
EXTERNAL LMASKB

	END