.TITLE	APPEND
/
/  31 JUL 74 (JAS) REMOVE DOPE VECTOR FROM FORMAL PARAMETERS
/   7 JUN 74 (JAF, JAS) IMPLEMENT BLOCK DATA
/  27 MAR 74 (JAS) REMOVE EXTRA WORD FROM CHARACTER DOPE VECTOR
/  20 FEB 74 (JAS,JAF) WORK ON ARITHMETIC STATEMENT FUNCTIONS
/   7 FEB 74 (JAF) ADD CODE FOR ARITHMETIC STATEMENT FUNCTIONS
/   5 SEP 73 (PDH) '.GLOBL %TABLE,%START'
/  30 MAY 73 (PDH) CHANGE ' .GLOBL .INTRP' TO ' .GLOBL AAAAA.'
/
	.GLOBL	APPEND,ITEMIN,ITEM4,ITEM5,INSRT,NAMEIT,ITEM,LOCCNT,DATCNT
	.GLOBL	BINAME,BINAM1,BASE,BASE1,BASE2,KIND,ERROR,BLOWN,DIMCNT
	.GLOBL	G.SCAN,WDSIZE,GETOTB,GETADR,EXCBIT,DEVICE,CHRCNT,HEADER
	.GLOBL	PTABLE,OTABLE,OTNEXT,CPOINT,ASFNUM,ASFOFF
	.GLOBL	%TABLE,%START	/LET 'SYMBOL' GET HOLD OF THESE VALUES
	.GLOBL	ARGCHN,ARGCNT,START,PNAME,PNAM1,PNAM2,MNAME,CLOSPG
	.GLOBL	CNAME,CHKNAM,NXTADR,COMPNT
/
/ THIS TABLE IS TO ALLOW CONVERSION FROM COMPILE TIME MODE BITS TO
/ EXECUTION (OBJECT) TIME OTABLE BITS.
EXCMOD	.DSA	LOGIMD*100000	/ LOGICM
	.DSA	INTMD*100000	/ SINTGM
	.DSA	DINTMD*100000	/ DINTGM
	.DSA	TEMPMD*100000	/ UNKOWN - TEMPORARY ACCUMULATOR
	.DSA	REALMD*100000	/ REALM
	.DSA	DOUBMD*100000	/ DBLEM
	0			/ NINTM
	0			/ DNINTM
	.DSA	CMPXMD*100000	/ CMPLXM
	0			/ UCMPXM
	.DSA	DCMPMD*100000	/ DCMPXM
	.DSA	CHARMD*100000	/ CHARACTER MODE
/
/
/ THIS SUBROUTINE CONVERTS COMPILE TIME MODE BITS TO EXECUTION TIME
/ MODE BITS
EXCBIT	XX
	AND	(17
	TAD	(EXCMOD-1
	DAC	TEMP
	LAC*	TEMP
	JMP*	EXCBIT	/ RETURN
/
/
TEMP;DPOINT;COUNT;OPT1;OPT2;NXTADR;FUNCHN;CCHARV
/
/ MUST BE INITIALIZED AT START OF NEXT JOB
START
/ -1
/ THE FOLLOWING ROUTINE PUNCHES OUT THE CONSTANTS
APPEND	XX
	LAC*	BLOWN
	SZA		/ IF PROGRAM HAS ERRORS
	JMP*	APPEND	/ BEAT A HASTY RETREAT
	LAC*	KIND
	SAD	(BLOCKD		/ IF BLOCK DATA, IGNORE MOST OF APPEND
	JMP	PUN23
	DZM	FUNCHN	/ INITIALIZATION FOR FUNCTION NAME CHAIN
	DZM	CNAME	/ RESET LAST COMMON NAME STORED
	DZM	CNAME+1
	LAW	-1
	TAD*	PTABLE
	DAC*	(AUTO12	/ SET AUTO-INDEX TO TOP OF PTABLE
/
AGCONS	LAC	(CONST	/ WANT CONSTANTS
	JMS*	G.SCAN
	SKP
	JMP	PDIMS	/ END OF PTABLE, GO PUNCH OUT DIMENSION
/
	DAC	DPOINT
	DAC*	(AUTO10
	LAC*	DPOINT	/ GET RELATIVE OTABLE ADDRESS OF CONSTANT
	JMS*	GETADR	/ CONVERT TO ABSOLUTE OTABLE ADDRESS
	DAC	OPT1
	LAC*	OPT1	/ GET COMPILE TIME MODE BITS
	JMS	EXCBIT	/ CONVERT TO OBJECT TIME MODE BITS
	TAD*	LOCCNT	/ ADD LOCATION COUNTER
	DAC*	OPT1	/ INSERT IN OTABLE
/
	LAC*	DPOINT	/ GET MODE OF CONSTANT
	AND	(17
	SAD	(CHARM	/ IS IT HOLLERITH
	JMP	HOLER	/ YES.
	JMS*	WDSIZE	/ GET SIZE OF STORAGE
	CMA
TAD1	TAD	(1
	DAC	COUNT	/ GIVES NUMBER OF WORDS TO TRANSFER
/
REMAIN	LAC*	AUTO10	/ GET CONSTANT
	JMS*	ITEM4	/ PUNCH OUT, CODE 04
	ISZ	COUNT	/ ARE WE FINISHED?
	JMP	REMAIN	/ NO. GO GET REMAINDER OF CONSTANT
	JMP	AGCONS	/ YES. GET NEXT CONSTANT
/
HOLER	LAC*	AUTO10	/ GET HOLLERITH WORD COUNT
	JMP	TAD1
	.EJECT
/
/
/ FIND ALL VARIABLES: PUNCH OUT DIMENSION TABLES, AND PUNCH OUT
/ THE CHARACTER VARIABLE DOPE VECTORS. SET UP ALL VARIABLES FOR
/ THE FINAL OTABLE SCAN.
CONTRL;TABPTR;OTSTRT
PDIMS	LAW	-1
	TAD*	PTABLE
	DAC*	(AUTO12	/ SET AUTO-INDEX FOR G.SCAN ROUTINE
	LAC*	ASFOFF	/SPACE REQUIRED FOR ASF
	SZA		/START SECTIONS
	TAD	(1
	TAD*	CHRCNT	/ GET SPACE NEEDED FOR CHAR DOPE VECTORS
	TAD*	DIMCNT	/ GET SPACE FOR DIMENSION TABLES
	TAD*	ARGCNT	/ SPACE FOR ARGUMENT STRINGS
	TAD*	LOCCNT	/ PLUS CURRENT LOCATION COUNTER
	DAC	OTSTRT	/ GIVES START ADDRESS OF OTABLE
/
AGVAR	LAC	(VARIAB	/ WANT VARIABLE
	JMS*	G.SCAN	/ GO SCAN PTABLE FOR VARIABLES
	SKP
	JMP	ARGLST	/ GO CHECK FOR ARGUMENT LISTS
/
	DAC	DPOINT	/ POINTS TO DTABLE
	TAD	(3
	DAC	CONTRL	/ POINTS TO CONTROL BITS
	LAC*	DPOINT
	AND	(17
	SAD	(CHARM	/ IS VARIABLE CHARACTER
	JMP	HAVCHM	/ YES. GO PROCESS IT
LOKDIM	LAC*	CONTRL	/ GET CONTROL BITS
	AND	(DIMENS!FUNBIT!FORMAL!NOHERE
	SAD	(FORMAL!NOHERE
	JMP	ASSOTB	/ FOUND DUMMY ARGUMENT
	AND	(DIMENS
	SNA		/ DOES VARIABLE HAVE DIMENSIONS
	JMP	AGVAR	/ NO.
/
/ VARIABLE HAS DIMENSIONS, PUNCH OUT THE TABLE.
	LAC*	DPOINT
	JMS*	GETADR	/ GET OTABLE ADDRESS
	TAD	(-2	/ NOW POINTS TO DIMENSION ENTRY
RET	DAC	OPT1
	TAD	(-1
	DAC	OPT2
	LAC*	OPT1	/ GET 1ST OTABLE WORD
	SMA		/ IS BIT SET
	JMP	ENDCHN	/ NO. END OF CHAIN
	LAC*	OPT2	/ YES. 2ND WORD POINTS TO ANOTHER OTABLE ENTRY
	JMP	RET
/
/ HAVE CHAINED DOWN TO THE DIMENSION TABLE
ENDCHN	CMA		/ WHEN BIT NOT SET, CONTAINS # OF SUBSCRIPTS
	DAC	TEMP	/ -(N+1)
	TAD	(1
	DAC	COUNT	/ GIVES NEGATIVE NUMBER OF ELEMENTS = -N
	LAC*	OPT2
	DAC	DPOINT	/ POINTS TO 1ST WORD OF DIM TABLE IN DTABLE
	TAD*	OPT1	/ CONTAINS # OF SUBSCRIPTS
	DAC	TABPTR	/ POINTS TO LAST WORD OF DIM TABLE
	LAC*	CONTRL	/ REGAIN CONTROL BITS
	AND	(FORMAL
	SZA
	JMP	FORMPR	/ WAS A FORMAL PARAMETER
/
/ REGULAR VARIABLE
	CLA
REGVAR	XOR*	LOCCNT	/ ADD LOCATION COUNTER TO TYPE BITS
	DAC*	OPT1	/ STORE FOR FINAL OTABLE PASS
	LAC*	TABPTR	/ GET ARRAY SIZE
	XOR	(DMOTB*100000	/ INSERT DIMENSION TABLE INDICATOR
	DAC*	OPT2	/ STORE IN OTABLE FOR SYMBOL TABLE ROUTINE
	LAC*	DPOINT	/ GET 1ST WORD (NOT REVERSED)
	JMS*	ITEM4
/
AG1	LAC*	TABPTR	/ PUNCH OUT THE N ENTRIES
	JMS*	ITEM4	/ CODE 04
	LAW	-1
	TAD	TABPTR
	DAC	TABPTR
	ISZ	COUNT
	JMP	AG1
	JMP	AGVAR
/
/ THIS SECTION SETS UP THE TWO WORD DOPE VECTORS FOR CHARACTER
/ VARIABLES AND PUNCHES THEM OUT.  THOSE CHAR VARIABLES NOT IN 
/ COMMON BUT IN DIMENSION, DATA, OR EQUIVALENCE HAVE ADDRESSES 
/ ASSIGNED.
/
HAVCHM	LAC*	CONTRL
	AND	(FORMAL
	SZA
	JMP	LOKDIM		/ NO DOPE VECTOR FOR FORMAL PARAMETERS
	LAC*	CONTRL
	AND	(DIMENS!DATSET!EQUSET!COMSET
	SNA!STL
	JMP	LOKDIM	/ CHAR VARIABLE DOESN'T HAVE DOPE VECTOR
	AND	(DIMENS
	SZA!CLA
	RAR
	DAC	TABPTR	/ 'TABPTR'=400000 IF CHAR VAR HAS DIMENSIONS, 
	LAC*	LOCCNT	/				ELSE = 000000.
	DAC	TEMP	/ SAVE CURRENT ADDRESS. (TO BE ADDRESS OF D. V.)
/
/ MARK VARIABLE AS HAVING A DOPE VECTOR FOR LATER OTABLE PUNCH
/ OUT SECTION.
	LAC*	CONTRL
	XOR	(DOPEVT
	DAC*	CONTRL
/
	LAC	CONTRL
	TAD	(1
	DAC	COUNT	/ POINTS TO CHAR SIZE
	LAC*	COUNT	/ GET CHAR SIZE
	TAD	(700000
	JMS*	ITEM4	/ 1ST WORD OF CHAR DOPE VECTOR
/
	LAC*	DPOINT
	JMS*	GETADR
	DAC	OPT1	/ ADDRESS OF OTABLE ENTRY
	TAD	(-1
	DAC	OPT2
	LAC*	OPT1
	AND	(077777	/ REMOVE COMMON BITS IF ANY
	XOR	TABPTR	/ 400000+ADDRESS OR 000000+ADDRESS
	TAD	(-1	/ ADDRESS-1
	DAC	TABPTR
	LAC	TEMP	/ INSERT ADDRESS OF DOPE VECTOR IN OTABLE
	DAC*	OPT1
	LAC*	CONTRL	/ GET CONTROL BITS
	AND	(COMSET
	SZA		/ IS CHARACTER VARIABLE IN COMMON
	JMP	INCOMM	/ YES.
	LAC	TABPTR
	JMS*	ITEM5	/ NO. PUNCH OUT 2ND WORD OF DOPE VECTOR
	JMP	LOKDIM
/
/ THE CHARACTER VARIABLE IS IN COMMON.  SET UP THE DOPE VECTOR
/ TO BE CHAINED  INTO COMMON.
INCOMM	LAC*	OPT1
	XOR	(200000
	DAC*	OPT1	/ MARK AS STILL IN COMMOM
	LAC*	OPT2	/ 2ND WORD CONTAINS DTABLE COMMON NAME ADDRESS
	JMS	CHKNAM	/ GO SET UP COMMON NAME
	LAC	TABPTR	/ RELATIVE ADDRESS
	JMS	PUNTRN	/ PUNCH OUT TRANSFER VECTORS FOR COMMON LINKAGES
	JMP	LOKDIM
/
/ VARIABLE IS A FORMAL PARAMETER
FORMPR	LAC*	CONTRL	/ REGAIN CONTROL BITS
	AND	(VARDIM
	SZA		/ HAS IT VARIABLE DIMENSIONS
	JMP	HASVD	/ YES.
/
/ FORMAL PARAMETER, NO VARIABLE DIMENSIONS
	LAC*	TABPTR	/ GET # OF ELEMENTS
	JMS*	ITEM4	/ PUNCH OUT
	CLA		/ MARK AS F.P. WITHOUT V.D.
	JMP	REGVAR
/
/ FORMAL PARAMETER WITH VARIABLE DIMENSIONS
HASVD	LAC*	OPT1	/ GET # OF SUBSCRIPTS = N
	TAD	(1	/ N+1
	JMS*	ITEM4	/ PUNCH OUT
	LAC	(400000	/ MARK AS F.P. WITH V.D.
	XOR*	LOCCNT	/ ADD LOCATION COUNTER
	DAC*	OPT1	/ STORE IN OTABLE
LOOPS	CLA
	JMS*	ITEM4	/ PUNCH OUT -(N+1) ZERO ITEMS
	ISZ	TEMP
	JMP	LOOPS
	LAC	COUNT	/ -N
	RCL		/ -2N
	DAC	TEMP
/ PUNCH OUT THE 2N ENTRIES AND CHANGE THE VARIABLES RELATIVE OTABLE
/ ADDRESSES TO ABSOLUTE
LOOP2	LAC*	DPOINT
	ISZ	DPOINT
	RCR		/ REGAIN CONSTANT OR VARIABLE, L_INDICATOR
	SZL		/ IS IT CONSTANT OR VARIABLE
	JMP	VARBLE	/ ITS VARIABLE
	JMS*	ITEM4	/ PUNCH OUT THE CONSTANT
	JMP	JOINV
/ MAKE RELATIVE VARIABLE OTABLE ADDRESS ABSOLUTE
VARBLE	XOR	(400000	/ MARK AS VARIABLE FOR EXECUTION
	TAD	OTSTRT	/ ADD START OF OTABLE
	JMS*	ITEM5	/ PUNCH OUT ABSOLUTE ADDRESS AS RELOCATABLE
JOINV	ISZ	TEMP	/ ARE WE THROUGH
	JMP	LOOP2	/ NO. CARRY ON
	JMP	AGVAR
/
/ VARIABLE IS A DUMMY ARGUMENT WHICH IS NOT USED. ASSIGN AN OTABLE
/ ENTRY FOR IT TO AVOID TROUBLE WHEN AGRUMENT ADDRESSES ARE PASSED.
/NOTE: ALL OTHER VARIABLES WITH 'NOHERE' SET HAVE NOT BEEN USED
/SO WE NEED NOT BOTHER GIVING THEM OTABLE SPACE.
ASSOTB	CLQ
	LAC	DPOINT
	JMS*	GETOTB	/ MAKE OTABLE ENTRY FOR DUMMY ARGUMENT
	CLQ!LLS	6
	LMQ
	LAC*	DPOINT
	AND	(000006
	OMQ
	DAC*	DPOINT
	JMP	AGVAR
	.EJECT
/
/THE FOLLOWING SECTION CHECKS FOR ANY SUBPROGRAM ARGUMENTS
/ AND PUNCHES THEM OUT LEAVING THE CORRECT ADDRESS IN ITS OTABLE ENTRY
ARGLST	LAC*	ARGCHN	/ ADDRESS OF START OF CHAIN
AGLIST	DAC	DPOINT
	SNA
	JMP	ASFOUT	/ EITHER NO CHAINS OR END OF CHAINS
	DAC*	(AUTO10
	LAC*	LOCCNT	/ GET LOCATION COUNTER
	DAC	COUNT	/ SAVE UNTIL WE FIND THE OTABLE ADDRESS
AGARG	LAC*	AUTO10	/ PICK UP ARGUMENT
	SMA
	JMP	ENDLST	/ END OF THIS LIST
	AND	(077777
	LMQ		/ MQ_0XYYYY
	ALS	3	/ AC_XYYYY0
	AND	(700000	/ AC_X00000
	SAD	(100000		/ASF ARGUMENT BEING PASSED TO
	JMP	ASFDUM		/ANOTHER FUNCTION AS A CONSTANT
	OMQ		/ AC_XXYYYY
	AND	(707777	/ AC_X0YYYY
AGJOIN	TAD	OTSTRT	/ GIVES ABSOLUTE ADDRESS IN OTABLE
	JMS*	ITEM5	/ CODE 05
	JMP	AGARG
ASFDUM	LAW	770000		/OFFSETS ARE NEGATIVE.  GET
	OMQ			/TOP BITS SET TO ONE'S.
	JMP	AGJOIN
/
ENDLST	LLS	6	/ CONTAINS RELATIVE OTABLE ADDRESS
	JMS*	GETADR	/ GET ABSOLUTE ADDRESS
	DAC	OPT1
	LAC	COUNT	/ REGAIN LOCATION COUNTER ADDRESS OF LIST
	DAC*	OPT1	/ STORE FOR LATER PUNCH
	LAC	(C.END*100000	/ INSERT END OF LIST INDICATOR
	JMS*	ITEM4	/ CODE 04
	LAC*	DPOINT
	JMP	AGLIST
	.EJECT
WORK;WORK1;CNT;CNT2
/  GENERATE ANY REQUIRED STATEMENT FUNCTION START SECTIONS.
/
ASFOUT	LAC*	ASFNUM		/NUMBER OF ASF'S
	SNA!CMA
	JMP	OTBOUT		/NO STATEMENT FUNCTIONS
	TAD	(1
	DAC	CNT		/ -# OF ASF'S
	LAC*	BASE2		/GET ADDRESS (+1) OF
	TAD*	ASFNUM		/LAST ASF POINTER
	DAC	OADDRS
/
/  PUNCH '.ASFCL' AS EXTERNAL GLOBAL
/
	LAC*	LOCCNT
	JMS*	ITEM5
	LAC	(POINT*100+AA*100+SS
	JMS*	NAMEIT		/OUTPUT '.ASFCL' AS CODE 7 & 10
	LAC	(FF*100+CC*100+LL
	LAW	-1
	TAD*	LOCCNT		/CORRECT LOCATION COUNT LOUSED UP BY 'ITEM5'
	DAC*	LOCCNT
	DAC	MLOC		/SAVE EXTERNAL ADDRESS
	JMS*	ITEMIN
	LAW	11		/CODE 11: EXTERNAL GLOBAL
/
/  NOW PROCEDE THROUGH ASF'S FROM LAST TO FIRST, PUNCHING THE CODE
/
/ASF	XX
/	JMS*	.ASFCL
/	-(ARGUMENT COUNT)
/	START ADDRESS
/	6 WORD OTABLE HEADER
/	0	FOR EACH ARGUMENT PUT ADDRESS OF ASF IN OTABLE ENTRY
/
ASFAGN	LAW	-1		/STEP TO NEXT ASF
	TAD	OADDRS
	DAC	OADDRS
	LAC*	OADDRS
	DAC	WORK		/POINTER TO OTABLE ENTRY
	TAD	(1
	DAC	WORK1
/
	LAC	(XX
	JMS*	ITEM4		/GENERATE 'XX'
/
	LAC	(JMS* 0
	TAD	MLOC
	JMS*	ITEMIN		/GENERATE 'JMS* .ASFCL'
	LAW	3
	LAC*	WORK1
	CMA
	TAD	(1
	DAC	CNT2		/- ARG COUNT
	JMS*	ITEM4		/GENERATE -COUNT
/
	LAC*	LOCCNT		/MODIFY ASF OTABLE ENTRY TO
	TAD	(100000-3       /POINT AT START SECTION
	DAC*	WORK1
/
	LAC*	WORK		/PICK UP STARTING ADDRESS
	AND	(77777
	JMS*	ITEM5		/GENERATE ENTRY
	JMS	HEADIT		/GENERATE FIRST 6 WORDS OF ASF OTABLE
	CLA
	JMS*	ITEM4		/GENERATE FORMAL PARAMETER ENTRIES
	ISZ	CNT2
	JMP	.-3
/
	ISZ	CNT
	JMP	ASFAGN
	.EJECT
/
/
/ THE FOLLOWING SCANS THE OTABLE AND PUNCHES IT OUT IN THE 
/ CORRECT FORM.
OTBOUT	LAC*	OTNEXT	/ ADDRESS OF LAST+1 OTABLE ENTRY
	CMA
	TAD*	OTABLE	/ GIVES SIZE OF OTABLE, TO WHICH WE
	RCR		/ DIVIDE BY 2 FOR OBJECT TIME SIZE
	TAD	(-1	/ GIVES OTABLE SIZE
	TAD*	LOCCNT	/ PLUS CURRENT VALUE OF LOCATION COUNTER
	DAC	NXTADR	/ GIVES START OF STORAGE ADDRESS
	LAC*	LOCCNT
	DAC	TABLE	/ STORE START ADDRESS OF TABLE
	JMS	HEADIT
	LAC*	OTABLE
	TAD	(-14		/SKIP OVER 1ST SIX ENTRIES
	JMP	AGAIN0
/
HEADIT	XX
	CLA
	JMS*	ITEM4	/ CODE 04
	CLA
	JMS*	ITEM4	/ CODE 04
	CLA
	JMS*	ITEM4	/ CODE 04
	LAC	PNAME	/ PUNCH OUT PROGRAM NAME
	JMS*	ITEM4
	LAC	PNAM1
	JMS*	ITEM4
	LAC	PNAM2
	JMS*	ITEM4
	JMP*	HEADIT
/
OADDRS
RESET	LAW	-2
	TAD	OADDRS
AGAIN0	DAC	OADDRS
AGAIN	DAC	OPT1
	TAD	(-1
	DAC	OPT2
	SAD*	OTNEXT	/ IS END OF OTABLE REACHED?
	JMP	STRTSC	/ YES. GO PUNCH OUT START SECTION
/
	LAC*	OPT2	/ GET 2ND WORD CONTAINING TYPE INDICATOR
	DAC	DPOINT
	LMQ
	AND	(700000
	SNA!CLL		/ IS IT A VARIABLE?
	JMP	VARIBL	/ YES.
	SAD	(CNOTB*100000	/ IS IT A CONSTANT?
	JMP	PUN		/ YES.
	SAD	(STOTB*100000	/ IS IT A STATEMENT NUMBER?
	JMP	STATES		/ YES.
	SAD	(DMOTB*100000	/ IS IT A DIMENSION TABLE?
	JMP	PUN		/ YES.
	SAD	(TAOTB*100000	/ IS IT A TEMPORARY ACCUMULATOR?
	JMP	TEMACC
	SAD	(SAOTB*100000	/ IS IT A SUBSCRIPTING ACCUMULATOR?
	JMP	SUBACC		/ YES.
	SAD	(FROTB*100000	/ IS IT A FUNCTION REFERENCE
	JMP	FUNC		/ YES.
	SAD	(AROTB*100000	/ IS IT A SUBPROGRAM ARGUMENT
	JMP	PUN
/
/
/ THE OTABLE ENTRY IS THAT OF A VARIABLE
VARIBL	LAC*	OPT1	/ GET 1ST WORD
	RTL
	SZL
	JMP	INCOMN	/ ITS IN COMMON
	LAC*	DPOINT	/ GET 1ST WORD OF DTABLE
	JMS	EXCBIT	/ GET OBJECT TIME MODE
	LMQ
	LAC	DPOINT
	TAD	(+3
	DAC	CONTRL	/ POINTS AT CONTROL BITS
	TAD	(1
	DAC	TEMP	/ POINTS TO CHAR SIZE IF CHARACTER
	LAC*	CONTRL
	AND	(FORMAL
	SZA!CLA		/ ADDRESSES ARE NOT ASSIGNED TO DUMMY ARGUMENTS
	JMP	PUN2	/ MAKE A ZERO ENTRY
	LAC*	CONTRL	/ REGAIN CONTROL BITS
	AND	(DIMENS!DATSET!EQUSET!DOPEVT
	SZA		/ HAS VARIABLE AN ADDRESS
	JMP	OKAY	/ YES.
	LAC	NXTADR	/ NO ADDRESS, ASSIGN ONE
	DAC*	OPT1	/ STORE IN OTABLE FOR SYMBOL TABLE LISTING
	OMQ		/ INSERT OBJECT TIME MODE BITS
	JMS*	ITEM5	/ PUNCH OUT, CODE 05
/ IF CHARACTER GETS HERE IT HAS NO DOPE VECTOR, IT IS JUST AN
/ ORDINARY CHAR VAR. PUNCH OUT HEADER WITH SIZE.
	LAC*	DPOINT
	AND	(17
	SAD	(CHARM
	JMP	ORDCHR	/ ITS ORDINARY CHAR
/ ORDINARY NON-CHARACTER VARIABLE
CHJOIN	LAC	TEMP
	DAC*	CPOINT	/ POINT AT THE NUMBER OF CHARS/ELEMENT
	LAC*	DPOINT	/ GET MODE FROM DTABLE
	JMS*	WDSIZE	/ GET STORAGE REQUIRED
	TAD	NXTADR
	DAC	NXTADR
	JMP	RESET
/
/ CHAR VARIABLES IN COMMON COME HERE EVENTUALLY
COKAY	LAC	(CHARMD*100000
	LMQ
OKAY	LAC*	OPT1	/ GET RELATIVE ADDRESS
	AND	(077777	/ CLEAR BITS FOR MODE
	OMQ		/ ADD MODE
	TAD	(-1	/ DECREMENT FOR AUTO-INDEX
	JMP	PUN2
/
/ PUNCH OUT THE HEADER WORD 6000000 + # OF CHARS
ORDCHR	LAC*	TEMP	/ GET CHAR SIZE
	XOR	(600000
	DAC*	ITEM
	LAC	(17
	JMS*	INSRT
	ISZ	NXTADR	/ RESERVE SPACE FOR HEADER WORD
	LAC	NXTADR
	DAC*	ITEM
	LAC	(22
	JMS*	INSRT
	JMP	CHJOIN
/ HANDLE VARIABLES IN COMMON ! CHECK IF THE COMMON NAME IS STILL VALID
/ AND THEN SCAN THE PTABLE LOOKING FOR VARIABLES IN COMMON
/ WHICH HAVE THE SAME OTABLE ADDRESS AS OUR PRESENT ENTRY
/ WE NEED THE MODE FROM THE DTABLE!!!!!!!
/ IF VAR IS A CHARACTER VARIABLE THEN IT HAS A DOPE VECTOR WHICH IS
/ ALREADY SET UP. JUST PUNCH OUT THE MODE BITS & DOPE VECTOR ADDRESS.
INCOMN	LAW	-1
	TAD*	PTABLE
	DAC*	(AUTO12	/ SET AUTO-INDEX TO SCAN PTABLE
TRYAGN	LAC	(VARIAB	/ WANT VARIABLES
	JMS*	G.SCAN
	SKP
	JMP	ERRCP4	/ ERROR IF END OF TABLE REACHED.
/
	DAC	DPOINT
	LAC*	DPOINT
	JMS*	GETADR	/ GET ABSOLUTE OTABLE ADDRESS
	SAD	OPT1	/ DOES IT MATCH OUR ENTRY
	SKP
	JMP	TRYAGN
/ NOW HAVE THE ASSOCIATED DTABLE ENTRY. DIMENSIONED CHARACTER VARIABLES
/ HAVE CONSTANT SUBSCRIPTS COMPILED AS VARIABLE, THUS WE CAN SIPHON
/ OFF ALL CHARACTER VARIABLES HERE.
	LAC*	DPOINT
	AND	(17
	SAD	(CHARM
	JMP	COKAY	/ ITS CHARACTER
	LAC*	OPT2	/ GET DTABLE ADDRESS OF COMMON ENTRY
	JMS	CHKNAM	/ CHECK ON COMMON NAME
	LAC*	DPOINT
	JMS	EXCBIT
	LMQ
	LAC*	OPT1	/ GET RELATIVE ADDRESS IN COMMON
/ THE NEXT 2 LINES ALLOW THIS CODING TO BE USED FOR CONSTANT
/ SUBSCRIPTS AS WELL
	TAD	CONSUB
	DZM	CONSUB
	AND	(077777
	OMQ		/ ADD MODE BITS
	TAD	(-1	/ DECREMENT FOR AUTO-INDEX
	JMS	PUNTRN	/ PUNCH OUT TRANSFER VECTORS
	JMP	RESET
/
ERRCP4	JMS*	ERROR	/ ERROR - DTABLE ENTRY NOT FOUND
	.SIXBT	'CP4'
	JMP	PUN
/
/ THIS SUBROUTINE CHECKS IF THE COMMON NAME IS THE LAST ONE USED.
CNAME	.BLOCK	2	/ RESERVE SPACE FOR LAST COMMON NAME
/
CHKNAM	XX
	DAC	COMPNT	/ SAVE POINTER TO COMMON DTABLE ENTRY
	DAC*	(AUTO10
	DZM	COUNT
	LAC*	AUTO10	/ GET 1ST THREE LETTERS OF COMMON BLOCK NAME
	SAD	CNAME	/ DO LETTERS MATCH
	ISZ	COUNT	/ YES. INDICATE SUCH
	DAC	CNAME	/ TO SAVE IRREGARDLESS
	LAC*	AUTO10	/ 2ND THREE LETTERS
	SAD	CNAME+1	/ DO THEY MATCH
	ISZ	COUNT	/ YES.
	DAC	CNAME+1	/ DEPOSIT
	LAC	(2
	SAD	COUNT
	JMP*	CHKNAM	/ NAMES ARE THE SAME.  AC .NE. 0
/
	LAC	CNAME	/ NAMES DON'T MATCH, PUNCH NEW ONE OUT.
	JMS*	NAMEIT
	LAC	CNAME+1
	LAC*	COMPNT	/ GET COMMON BLOCK SIZE
	DAC	COMPNT
	DAC*	ITEM
	LAC	(14	/ CODE 12
	JMS*	INSRT	/ 'INSRT' DOES NOT INCREMENT LOCATION COUNTER
	CLA			/ CLEAR AC TO INDICATE A CHANGE IN
	JMP*	CHKNAM		/ COMMON NAME
COMPNT	0
/
/ PUNCH OUT THE TRANSFER VECTORS
PUNTRN	XX
	DAC*	ITEM
	LAC	(15	/ CODE 13
	JMS*	INSRT
	LAC*	LOCCNT	/ GET PRESENT LOCATION COUNTER VALUE
	DAC*	ITEM
	LAC	(16	/ CODE 14
	JMS*	INSRT
	CLA		/ MAKE ZERO ENTRY
	JMS*	ITEM4
	JMP*	PUNTRN
/
/ THE OTABLE ENTRY IS THAT OF AN STATEMENT NUMBER
/
STATES	LAC*	DPOINT
	AND	(77	/ CLEAR OFF ADDRESS
	SNA
	JMP	PUN	/ INTERNAL STATEMENT NUMBERS GO OUT HERE
	SAD	(.IOPUT
	JMP	ERRSTA	/ ERROR - USED IN I/O, NOT DEFINED IN FORMAT
	AND	(NON.EX!.EXC!FORM
	SNA
	JMP	ERRST0	/ ERROR - NOT DEFINED AT ALL
	AND	(FORM
	SNA
	JMP	PUN	/ JUST AN ORDINARY STATEMENT NUMBER
	LAC*	OPT1	/FIX UP FORMAT STATEMENT NUMBER TO
	XOR	(TEMPMD*100000	/LOOK LIKE CHARACTER
	JMP	PUN1		/CONSTANT.
ERRSTA	JMS*	ERROR	/ ERROR - MISSING FORMAT STATEMENT
	.SIXBT	'STA'
	JMP	PUN
ERRST0	JMS*	ERROR	/ ERROR - MISSING STATEMENT NUMBER
	.SIXBT	'ST0'
	JMP	PUN
/
/ THE ENTRY IS THAT OF A TEMPORARY ACCUMULATOR
TEMACC	LACQ
	AND	(077777
	JMS	EXCBIT	/ GET EXECUTION TIME MODE BITS
	TAD	NXTADR	/ INSERT STORAGE ADDRESS
	JMS*	ITEM5	/ CODE 05
/
	LAC*	OPT2
	JMS*	WDSIZE	/ GET SIZE OF STORAGE NEEDED
	TAD	NXTADR
	DAC	NXTADR	/ INCREMENT STORAGE ADDRESS TO NEXT FREE ADDRESS
	JMP	RESET
/
/ THE ENTRY IS THAT OF A SUBSCRIPTING ACCUMULATOR
SUBACC	LAC*	OPT1
	SMA!RAL
	JMP	VRSUB
	SMA!RAL
	JMP	CNSUB
/ CHARACTER SUBSCRIPT ACCUMULATOR, ASSIGN A 2 WORD DOPE VECTOR TO
/ AT THE END WITH THE VARIABLES.
	LAC	NXTADR	/ ADDRESS OF DOPE VECTOR
	XOR	(700000	/ MARK AS CHARACTER SUB ACC
	JMS*	ITEM5	/ PUNCH OUT OTABLE ENTRY
	ISZ	NXTADR
	ISZ	NXTADR	/ RESERVE SPACE
	JMP	RESET
/
/ VARIABLE SUBSCRIPT ACCUMULATOR
VRSUB	CLA
	JMS*	ITEM4
	JMP	RESET
/
/ FOR THE FORM X(10)
CNSUB	LACQ		/ GET OTABLE ADDRESS
	AND	(007777	/ REMOVE OTABLE TYPE INDICATOR & MODE
	RAL
	CMA
	TAD	(1
	TAD*	OTABLE	/ GET ABSOLUTE OTABLE ADDRESS
	DAC	TEMP
	LAC*	TEMP	/ GET BASE ADDRESS OF VARIABLE
	RAL
	SMA!RAR		/ IS VARIABLE IN COMMON?
	JMP	NOTIN	/NO.
	LAC*	OPT1	/ GET CONSTANT OFFSET
	DAC	CONSUB
	LAC	TEMP	/ ADDRESS OF OTABLE FOR VARIABLE ITSELF
	JMP	AGAIN	/ GO PROCESS AS A VARIABLE, WITH 'CONSUB' SET
CONSUB
/
/ THE VARIABLE BEING SUBSCRIPTED IS NOT IN COMMON. THUS
/ IT ALREADY HAS A BASE ADDRESS.
NOTIN	TAD*	OPT1	/ ADD OFFSET TO BASE
	AND	(077777
	LMQ
	LAC*	OPT2
	RTL;	RAL	/ LEFT JUSTIFY MODE
	AND	(700000
	OMQ		/ ADD IN ADDRESS
	JMP	PUN1
/
/
/ FUNCTION NAMES
/ ALL FUNCTIONS ARE CHAINED TOGETHER TO AVOID AN OTABLE SEARCH
/ WHEN IT IS TIME TO PUNCH OUT THE FUNCTION NAMES AND MARK THEM
/ AS EXTERNAL GLOBALS.
FUNC	LAC*	OPT1
	AND	(700000
	SAD	(100000	/ IS IT AN ARITHMETIC STATEMENT FUNCTION?
	JMP	ASFFND	/ YES.
	ISZ	DPOINT
	ISZ	DPOINT
	LAC*	DPOINT	/ GET CONTROL BITS
	AND	(FORMAL
	SZA!CLA		/ IF FORMAL SET, FUNCTION IS PROGRAM NAME
	JMP	PUN2	/ ITS PROGRAM NAME.
/ ADD PRESENT FUNCTION TO CHAIN. THE END OF THE CHAIN IS 
/ MARKED BY X00000.
	LAC	FUNCHN
	TAD*	OPT1	/ ADD CONTROL BITS TO ADDRESS
	DAC*	OPT1
	LAC	OPT1
	DAC	FUNCHN	/ RESET 'FUNCHN'
	LAC*	LOCCNT	/ TRANSFER VECTOR MUST CONTAIN ITS OWN ADDRESS
	JMP	PUN2
/
ASFFND	XOR*	OPT1		/REMOVE FLAG AND
	JMP	PUN2		/PUNCH ASF ADDRESS
/
/ THIS SECTION PUNCHES OUT THOSE OTABLE ENTRIES WHICH ARE ALREADY
/ COMPLETE.
PUN	LAC*	OPT1
PUN1	TAD	(-1	/ DECREMENT ADDRESS FOR AUTO-INDEX USE.
PUN2	JMS*	ITEM5	/ CODE 05, RELOCATABLE CODE
	JMP	RESET
	.EJECT
/
/
/ THE START SECTION FOR SUBPROGRAMS AND MAINLINES FOLLOWS
/ THE GENERAL FORM IS:
/ M	SUBNAM	XX		/ INTERNAL GLOBL SUBNAM
/ M+1		JMS*	.PULL.
/ M+2		        PARMLIST
/ .			.
/ .			.
/			.
/		.DSA	777777	/ END OF LIST
/ L		JMS*	AAAAA.
/ L+1		.DSA	TABLE	/ OTABLE ADDRESS
/ L+2		.DSA	START-1	/ START ADDRESS-1 OF CODE
/ L+3	AAAAA.	0		/ EXTERNAL GLOBL AAAAA.
/ L+4	.PULL.	0		/ EXTERNAL GLOBL .PULL.
/
/  ** NB **  NOTE THAT 'AAAAA.' WAS ORIGINALLY '.INTRP', BUT
/	     WAS CHANGED TO ELIMINATE A PROBLEM THE LOADER HAS
/	     IN RESOLVING GLOBALS FROM LIBRARY ROUTINES.
/
/
TABLE
%TABLE=TABLE		/EQUIVALENCES FOR 'SYMBOL'
%START=START
/
STRTSC	ISZ	NXTADR	/ ADDRESS WAS ONE LOW, GET PROGRAM SIZE
/
/ RELOCATE THE START SECTION TO THE FRONT OF THE PROGRAM
	CLA
	JMS*	ITEMIN	/ THE START ADDRESS IS ZERO
	LAW	2
/
/ PUNCH OUT THE START SECTION
/ IF HEADER=4 - MAINLINE
/           5 - NO PARAMETER SUBROUTINE
/           8+N - N PARAMETER SUBROUTINE
/ IN EACH CASE HEADER GIVES THE STORAGE NEED FOR THE START SECTION.
	LAC	(4
	SAD*	HEADER	/ IS IT MAINLINE
	JMP	NOARGS	/ YES.
/
	LAC	(HLT
	JMS*	ITEM4	/ START OF SUBROUTINE
	LAC*	HEADER
	SAD	(5	/ DOES SUBPROGRAM HAVE PARAMETERS
	JMP	NOARGS	/ NO.
/ PROGRAM HAS FORMAL PARAMETERS
	TAD	(JMS  17777	/ JMS* -1
	JMS*	ITEMIN		/ GENERATE	JMS*	.PULL.
	LAW	3		/ CODE 3
/
/ PUNCH OUT THE SUBPROGRAM FORMAL PARAMETERS
	LAW	-1
	TAD*	BASE
	DAC*	(AUTO10	/ POINT TO FORMAL PARAMETERS
AGARGM	LAC*	AUTO10	/ PICK UP ARGUMENT ADDRESS
	SAD	(777777	/ IS IT END OF LIST
	JMP	ENDARG
/
	DAC	TEMP
	TAD	(3
	DAC	DPOINT
	LAC*	TEMP
	CLL
	LRS	6
	TAD	TABLE	/ GET ABSOLUTE ADDRESS IN TABLE
	LMQ
	LAC	TEMP
	AND	(700000	/ GET INDICATOR BITS
	SAD	(STOTB*100000
	JMP	STATEM	/ ARGUMENT IS STATEMENT NUMBER
	LAC*	DPOINT	/ GET CONTROL BITS
	AND	(DIMENS!FUNBIT!DFINED
	SAD	(DIMENS
	LAC	(S.DIM*100000	/ DIMENSIONED VARIABLE
	SAD	(DIMENS!DFINED
	LAC	(S.DIM*100000	/ DIMENSIONED VARIABLE
	SAD	(FUNBIT
	LAC	(S.FUN*100000	/ FUNCTION NAME
	SAD	(FUNBIT!DFINED
	LAC	(S.FUN*100000	/ FUNCTION NAME
	SAD	(DFINED
	LAC	(S.RET*100000	/ RETURNED VALUE VARIABLE
	SNA
	LAC	(S.VAR*100000	/ SIMPLE VARIABLE
	SKP
/
STATEM	LAC	(S.STN*100000
	OMQ
	JMS*	ITEM5	/ CODE 05
	JMP	AGARGM
/
/ END OF FORMAL PARAMETERS
ENDARG	JMS*	ITEM4	/ CODE 04, PUNCH OUT END OF STRING INDICATOR
	LAW	-1
	TAD*	HEADER	/ CALCULATE ADDRESS OF .INTRP GLOBL
/
/ NO FORMAL PARAMETERS OR MAINLINE ENTER HERE
NOARGS	DAC	LINTRP
	DAC	MLOC	/ SAVE IN CASE OF .PULL. GLOBL
	TAD	(JMS	17777	/ JMS* -1
	JMS*	ITEMIN	/ PUNCH OUT JMS* .INTRP
	LAW	3	/ CODE 3
/
	LAC	TABLE	/ PUNCH OUT START ADDRESS OF TABLE
	JMS*	ITEM5	/ L+1
/
	LAC	START	/ PUNCH OUT START-1 OF CODE ADDRESS
	JMS*	ITEM5	/ L+2
/
	LAW	-1
	TAD	LINTRP
	DAC	LINTRP	/ GET CORRECT ADDRESS OF .INTRP GLOBL
	JMS*	ITEM5	
/
/
/ NOW PUNCH OUT STANDARD STARTING SECTION FOR ALL PROGRAMS
NOTSUB	LAC	(01*50+01*50+01+400000	/ 'AAA'
	JMS*	ITEMIN
	LAC	(07
/
	LAC	(01*50+01*50+34		/ 'AA.'
	JMS*	ITEMIN
	LAW	10	/ CODE 8
/
	LAC	LINTRP	/ GET LOCATION OF .INTRP (AAAAA.=.INTRP)
	JMS*	ITEMIN
	LAW	11	/ TELL LOADER AAAAA. IS EXTERNAL GLOBL
/
/ PUT IN THE LOCATION FOR .PULL. AND ITS GLOBL IF NECESSARY.
	LAW	-6
	TAD*	HEADER
	SPA		/ IS HEADER > 5
	JMP	NOPULL	/ NO
	LAC	MLOC	/ GET ADDRESS OF .PULL.
	JMS*	ITEM5
/
	LAC	(34*50+20*50+25+400000	/ .PU
	JMS*	ITEMIN
	LAW	7
/
	LAC	(14*50+14*50+34	/ LL.
	JMS*	ITEMIN
	LAC	(10
/
	LAC	MLOC
	JMS*	ITEMIN
	LAC	(11	/ EXTERNAL GLOBL .PULL.
/
/ NOW PUNCH OUT ANY EXTERNAL GLOBAL REFERENCES. THEY ARE ALL CHAINED
/ TOGETHER.
NOPULL	LAC	FUNCHN	/ GET START OF FUNCTION CHAIN
	JMP	TRY
NXTFUN	DAC	OPT1	/ POINTS TO NEXT FUNCTION IN CHAIN
	TAD	(-1
	DAC	OPT2
	LAC*	OPT2	/ GET POINTER TO DTABLE
	DAC	TEMP
	TAD	(1
	DAC	COUNT
	TAD	(-2
	DAC	DPOINT	/ POINTER TO 1ST WORD OF DTABLE
	LAC*	TEMP	/ GET 1ST THREE LETTERS OF NAME
	JMS*	NAMEIT	/ PUNCH OUT
	LAC*	COUNT	/ 2ND THREE LETTERS OF NAME
	LAC*	DPOINT	/ GET 1ST WORD OF DTABLE
	CLL
	LRS	6	/ GET OBJECT TIME RELATIVE ADDRESS
	TAD	TABLE	/ ADD TABLE START ADDRESS FOR LOCATION COUNTER
	JMS*	ITEMIN
	LAW	11	/ CODE 9 , EXTERNAL GLOBAL
	LAC*	OPT1
	AND	(077777
TRY	SZA		/ IS IT END OF CHAIN ?
	JMP	NXTFUN	/ NOT END OF CHAIN
/
/ NOW HANDLE THE DEVICE REQUESTS
	LAC	(400000
	DAC*	ITEM	/ SETUP IN CASE WE NEED ALL DEVICES
	LAC*	DEVICE
	DAC	COUNT
	SAD	(777777	/ DO WE WANT ALL DEVICES
	JMP	ISSUES	/ YES
/
	LAW	-10
	DAC	COUNT	/ ONLY 8 DEVICE SLOTS
RING	LAC*	DEVICE
	RCL
	DAC*	DEVICE
	SNL		/ IS LINK SET
	JMP	NODEV	/ NO, COUNT IT
/
	LAC	COUNT	/ YES. REQUEST THE DEVICE
	TAD	(11	/ CONVERT 1 TO 8
	DAC*	ITEM
ISSUES	LAC	(26	/ 22 OCTAL
	JMS*	INSRT
/
NODEV	ISZ	COUNT	/ HAVE ALL DEVICES BEEN TRIED
	JMP	RING
/
/ PUNCH OUT THE CODE 23 TO INDICATE THE START ADDRESS AND THE END
/ OF THIS PROGRAM UNIT. THEN FILL THE GROUP OUT WITH ZERO CODES
PUN23	DZM*	ITEM
	LAC	(27	/ CODE 23
FILLGP	JMS*	INSRT	/ PUNCH IT OUT
	LAW	-3
	XOR*	DATCNT
	SZA!CLA		/ IS GROUP FULL
	JMP	FILLGP	/ NO. PUNCH OUT A ZERO CODE
/
/ GO CLOSE OUT THIS PROGRAM
	LAC	NXTADR	/ CARRY ALONG PROGRAM SIZE
	JMS*	CLOSPG
/
	JMP*	APPEND
/ 
/ STORAGE LOCATIONS
LINTRP		/ CONTAINS LOCATION OF .INTRP GOBAL ADDRESS
MLOC		/ USED FOR ADDRESS OF .PULL. AND OTHER THINGS
/ THE NAME FOR FORTRAN MAINLINE PROGRAMS FOLLOWS
MNAME	.ASCII	'MAIN/L'
/ THE FOLLOWING BUFFER HOLDS THE ASCII PROGRAM NAME FOR INSERTION IN
/ THE OTABLE
PNAME	0
PNAM1	0
PNAM2	0
	.END