Google
 

Trailing-Edge - PDP-10 Archives - BB-H506D-SM_1983 - cobol/source/ipcgen.mac
There are 14 other files named ipcgen.mac in the archive. Click here to see a list.
; UPD ID= 3245 on 11/18/80 at 4:10 PM by NIXON                          
TITLE	IPCGEN FOR COBOL V12B
SUBTTL	GENERATORS FOR SUBPROGRAMMING STATEMENTS	CHUCK MCCOMAS



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974, 1981 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	P
	%%P==:%%P

;EDITS
;NAME	DATE		COMMENTS

;V12*****************
;DAW	24-JUL-80	[1041] BAD CODE GENERATED FOR "CALL <IDENTIFIER>"
;DMN	26-MAR-80	[1002] CHANGE CHECK FOR MISSING CALL/ENTER ARGS.
;DMN	24-OCT-79	[752] COBOL-74  ILLEGAL INST. IF DATAB CONTAINS ERRORS

;V12*****************
;MFY	1-FEB-79	[632] REMOVE SECOND (WRONG) DEFINITION OF ARGSGN
;DAW	4-OCT-78	[565] PASS NUMERIC EDITED FIELDS TO A SUBROUTINE CORRECTLY

;V10*****************
;VR	20-MAY-77	[475] PASS NUMERIC AND SIGN BITS TO MACRO SUBROUTINE CORRECTLY
;EHM  23-JUN-76 	[432] PASS NUMERIC FIELDS TO A SUBROUTINE CORRECTLY
;			PASS SIGN BIT CORRECTLY, USE EXTERNAL SIZE
;	3/19/76		[411] CORRECT PARAM WORD SETTING FOR SUBSCRIPTED USING ARGS
;DBT	1/18/75		REVERSE PUTASY AND PUTASN CALLS IN ENTRY GENERATION
;			UUO WAS NOT BEING SENT TO PUTASY
;GPS	12/23/74	MAKE ARG AND SARG SUBROUTINES AVAILABLE FOR USE BY SIMULTANEOUS UPDATE
;DBT	12/18/74	MODIFY CANGEN TO GENERATE AN ARGUMENT LIST
;			FOR THE CANCEL CALL WHICH PASSES THE ADDRESS
;			OF THE SUBROUTINE TO BE CANCELED RATHER THAN
;			THE NAME OF IT
;DBT	1/23/75		REVERSE PUTASY/ASN CALLS IN GOBKGN
;DBT	1/24/75		DETECT CANCEL OF CURRENT ROUTINE
;DBT	1/24/75		REVERSE PTASY/N CALLS IN ENTRYGEN
;DBT	6/23/75		GENERATE THE SIXBIT ENTRY NAME AT ENTRY-1 AND
;			GENERATE A POINTER TO THE MAIN ENTRY POINT AT
;			ENTRY-2.  THESE WILL BE USED BY COBDDT AND
;			LIBOL ERROR HANDLING.
;********************

; EDIT 330 SKIP SUBARG IF ANY FATAL ERROR AND FIX GOING AROUND SUBSCRIPT IN DUMMY ARGUMENT
; EDIT  324 JUMP AROUND DECLARITIVES IF ANY IN A SUBPROGRAM
; EDIT 254 PREVENT INDIRECT BIT BEING TURNED FOR COMP USING ARG AT WRONG TIME
;**; EDIT 124 FIX UP CALL FOR USING ARGS
;**;	EDIT 112 PASS CORRECT USAGE FOR USING ARGUMENTS IN CALL AND ENTER STATEMENTS.


TWOSEG
RELOC	400000
SALL

ENTRY	ENTRGN		;ENTER AND CALL
ENTRY	ARGGEN		;USING
ENTRY	GOBKGN		;GOBACK AND EXIT PROGRAM
ENTRY	NTRYGN		;ENTRY
ENTRY	CANGEN		;CANCEL
ENTRY	PUTOC0		;PUT AN OCTAL 0 IN AS1FIL
ENTRY	SARG		;GENERATE CODE TO EVALUATE SUBSCRIPT
ENTRY	ARG		;SET UP TO GENERATE CODE FOR ARGUMENT

EXTERN	STASHI,STASHL,STASHP,STASHQ,POOLIT,CPOPJ
EXTERN	PUT.EX,PUT.PJ

IPCGEN::
SUBTTL	GENERATE AN "ENTER" OR "CALL"

IFN ANS68,<
ENTRGN:	TLNE	W1,(CALLF!MACRO!F10)	;IS THIS A "CALL" OR ENTER MACRO OR ENTER FORTRAN?
	JRST	CALLGN		;YES, USE NEW CALLING SEQUENCE

;ENTER FORTRAN-IV -- USE OLD CALLING SEQUENCE

	SWOFF	FEOFF1		;TURN OFF MOST FLAGS
	MOVEM	W1,OPLINE
	PUSHJ	PP,READEM
	MOVEM	EACA,EOPNXT##
	EXCH	W1,OPLINE
	HRRZ	TE,W2
	CAIN	TE,ARGOP.
	PUSHJ	PP,SUBARG

	HRRZ	TA,EOPLOC	;PICK UP OPERAND'S TABLE-LINK
	MOVE	CH,2(TA)
	ANDI	CH,77777	;CLEAR ALL BUT LOW-ORDER 15 BITS
	IORI	CH,AS.EXT	;SET "EXTERNAL"

	HRLI	CH,AC16+JSA.##	;F40 -- USE JSA WITH IN LINE ARGS
	PUSHJ	PP,PUTASY##

	TSWT	FAS3		;ARE WE IN NON-RESIDENT SEGMENT?
	JRST	ENTR4		;NO--GO TO "USING"

	MOVE	TA,2(TA)	;YES--GET OPERAND LINK
	PUSHJ	PP,LNKSET##	;GET EXTAB ADDRESS
	SETO	TE,		;SET "REFERENCED IN NON-RES"
	DPB	TE,EX.NRS

ENTR4:	MOVE	W1,OPLINE
	HRRZ	TE,W2
	CAIN	TE,ARGOP.
	JRST	ARGGEN

ENTR5:	MOVE	TD,EOPLOC
	HRLI	TD,2(TD)
	MOVN	EACA,[XWD 2,2]
	ADDB	EACA,EOPNXT
	BLT	TD,0(EACA)
	JRST	@EOPCOD##(TE)
>
SUBTTL	GENERATE "USING" ARGUMENT LIST FOR ENTER FORTRAN-IV

ARGGEN:	TSWF	FERROR		;IF ERRORS WERE SEEN,
	POPJ	PP,		;  QUIT

	HRRZ	TC,EOPLOC	;AIM CUREOP AT FIRST USING OPERAND
	ADDI	TC,3
	MOVEM	TC,CUREOP##

ARGEN1:	PUSHJ	PP,ARG		;PROCESS CURRENT ARG OPERAND

;GENERATE IN LINE ARG LIST ENTRY FOR THIS OPERAND

	MOVE	TC,CUREOP	;SET PTR TO OPERAND
	MOVE	CH,(TC)		;GET 1ST WORD TO PUT OUT
	JUMPE	CH,ARGN3B	;NONE THERE
	PUSHJ	PP,PUTASY
	MOVE	CH,1(TC)	;SECOND WORD
	JUMPE	CH,ARGN3B	;NONE THERE
	PUSHJ	PP,PUTASN##

ARGN3B:	MOVEI	TC,2		;BUMP UP TO NEXT EOPTAB ENTRY
	ADDB	TC,CUREOP
	MOVE	EACA,EOPNXT	;END OF LIST?
	CAIL	TC,(EACA)
	POPJ	PP,		;YES

	SKIPE	(TC)		;NO, THIS A WIPED OUT SUBSCRIPT?
	JRST	ARGEN1		;NO, PROCESS IT
	JRST	ARGN3B		;YES, TRY NEXT ENTRY
;SCAN THRU ARGUMENT OPERANDS LOOKING FOR SUBSCRIPTED ITEMS

SUBARG:	MOVEM	EACA,EOPNXT
	HRRZ	TC,EOPLOC
	ADDI	TC,3
	CAIL	TC,(EACA)
	JRST	BADEOP##

SARG1:	MOVEM	TC,CUREOP

	PUSHJ	PP,SARG		;SET UP SUBSCRIPTS FOR CURRENT ARG

	MOVE	EACA,EOPNXT
	CAIL	TC,(EACA)
	POPJ	PP,
	JRST	SARG1
SUBTTL	CALL/ENTER ARGUMENT ROUTINES

;PROCESS ONE ARG OPERAND
;  PUT 2-WORD DESCRIPTOR IN LITERALS IF NECESSARY
;  AND SET UP CODE TO PUT OUT TO ASSEMBLY FILE

ARG:	TSWF	FFATAL		; [330] ANY FATAL ERRORS IN PROGRAM?
	POPJ	PP,		; [330] YES GO NO FURTHER
	AOS	ARGCTR		;COUNT ARGS

	MOVE	TE,0(TC)	;IS IT A LITERAL?
	TLNE	TE,GNLIT
	JRST	ARGN1B		;YES
	MOVE	TE,1(TC)	;NO--IS IT A DATA-NAME?
	TLNE	TE,GNNOTD	;IS IT A TEMP?
	JRST	ARGN1B		;YES
	LDB	TD,[POINT 3,TE,20]
	CAIN	TD,TB.DAT##
	JRST	ARGN1B		;YES
	TLNN	TE,FLOBIT##	;NO--BETTER BE PROCEDURE-NAME
	CAIN	TE,TB.PRO##
	JRST	ARGEN9		;IT MUST BE
	JRST	ARGN9B		;IT ISN'T

ARGN1B:	MOVEI	LN,EBASEA##
	PUSHJ	PP,SETOPN##
	TSWF	FERROR;
	JRST	ARGN9C

	HRRZ	TE,EMODEA##
	CAIN	TE,LTMODE##
	JRST	ARGEN4

	CAIN	TE,FCMODE##
	JRST	ARGEN8

	MOVE	TA,CUREOP		;[432] GET DATAB LINK
	HRRZ	TA,1(TA)		;[432] 
	CAIL	TA,<CD.DAT>B20		;[432]BE SURE IT IS DATAB LINK
	CAILE	TA,<CD.DAT>B20+77777	;[432]
	JRST	ARGN12			;[432] NOT DATAB LINK
	PUSHJ	PP,LNKSET		;[432] GET EXTERNAL SIZE
	LDB	TB,DA.EDT##	;EDITED?
	JUMPE	TB,ARGN12	;NO, SKIP THIS
	LDB	TB,DA.EXS##		;[432] TO PASS TO SUBROUTINE
	MOVEM	TB,ESIZEA		;[432] SO SUB KNOWS REAL SIZE
	MOVE	TA,CUREOP
	MOVSI	TB,GNFCS	;GET FLAG WHICH WILL MEAN "EDITED"
	IORM	TB,(TA)		;SET IN OPERAND WORD (SEE "SARG+FEW")

ARGN12:	MOVSM	TC,OPERND##
	PUSHJ	PP,SUBSCA##
	HLRZ	TC,OPERND

	MOVE	TE,EMODEA
ARGN1A:	MOVE	CH,ARGLST(TE)	;GET ARGUMENT TYPE

	CAILE	TE,	DSMODE##	;IF IT'S NOT DISPLAY
	CAIN	TE,	C3MODE##	; OR COMP-3
	TRNA
	JRST		ARGEN2		; GO ON.

	MOVE	TE,1(TC)	;IS IT A TEMP?
	TLNE	TE,GNNOTD
	JRST	ARGN2A		;YES--SUBSCRIPTED
;ARGUMENT IS DISPLAY ITEM

ARGN1C:	MOVE	TA,[XWD BYTLIT##,2]
	PUSHJ	PP,STASHI
	PUSHJ	PP,MBYTEA##

	PUSHJ	PP,ARSUB2	;ZERO OUT SUBSCRIPTS
	PUSH	PP,CH		;SAVE ARG TYPE FOR LATER
	HRRZ	CH,ELITPC	;SAVE LIT PTR FOR ASY OUTPUT
	IORI	CH,AS.LIT
	PUSH	PP,CH
	AOS	ELITPC##

;SET UP THE SECOND WORD FOR ARG TYPE 15.

	MOVE	TA,	[XWD	OCTLIT##,1]	;WRITE IT OUT IN OCATAL.
	PUSHJ	PP,	STASHI

	SETZI	TA,			;BUILD IT IN TA.

	MOVE	TE,	EMODEA##	;SET UP THE MODE FIELD.
	CAIN	TE,	C3MODE##
	MOVEI	TE,	C3ARG-1
	ADDI	TE,	1
	DPB	TE,	ARGMOD

	MOVE	TE,	CUREOP##		;GET THE GENFIL FLAGS.
	MOVE	TE,	(TE)

	TLNN	TE,	GNLIT		;[432]TEST FOR LITERAL
	JRST	ARGN1D			;[432] NOT LITERAL
	TLO	TA,	ARGLIT		; SET THE LITERAL
	TLNE	TE,	GNALL		; AND ALL FLAGS.
	TLO	TA,	ARGALL
	JRST	ARGN1E			;[432] JUMP AROUND NUM SWITCH
ARGN1D:	TLNE	TE,GNOPNM		;[432] FOR NUMERIC EDITED SET
	SWON	FANUM			;[432] SWITCH ON TO PASS
	TSWT	FANUM;
ARGN1E:	JRST		ARGN1K		;[432]IF IT'S NOT NUMERIC, GO ON
	TLO	TA,	ARGNUM
	TLNE	TE,	GNFCS		;(SEE SARG+FEW) IF NUMERIC EDITED,
	TLO	TA,	ARGEDT		;SET "EDITED" BIT

;  NUMERIC ARG.

	TSWF	FASIGN;			;TRANSFER THE SIGN FLAG.
	TLO	TA,	ARGSGN

	MOVE	TE,	EDPLA##		;DECIMAL PLACES?
	JUMPGE	TE,	ARGN1G		;IF IT'S POSITIVE, THEY ARE REAL
					; GO ON.
	MOVMS		TE		;IT'S NEGATIVE - IT'S ACTUALLY
					; THE SCALE FACTOR.
	TLO	TA,	ARGSCL		;NOTE IT.

ARGN1G:	DPB	TE,	ARGNDP		;STASH THE SCALE FACTOR (OR
					; OR DECIMAL PLACES.)

	MOVE	TE,	ESIZEA##	;GET THE SIZE.
	DPB	TE,	ARGNSZ		;STASH IT.
	JRST		ARGN1P		;GO STASH THE WORD.

;  NON-NUMERIC ARG.

ARGN1K:	MOVE	TE,	ESIZEA##	;GET THE SIZE.
	DPB	TE,	ARGDSZ		;STASH IT.

ARGN1P:	PUSHJ	PP,	STASHL##	;STASH THE LITERAL.
	AOS		ELITPC##	;BUMP THE PC.

	MOVE	TC,CUREOP	;SET UP ASY FILE OUTPUT
	MOVE	CH,-1(PP)	;GET BACK ARG TYPE
	HRRI	CH,AS.MSC
	TLO	CH,ASINC
	MOVEM	CH,(TC)
	POP	PP,CH		;GET LIT PTR
	MOVEM	CH,1(TC)
	POP	PP,CH		;SCRATCH ARG TYPE FROM PDL
	POPJ	PP,		;RETURN

	ARGLIT==(1B5)
	ARGALL==(1B6)
	ARGNUM==(1B7)
	ARGSGN==(1B8)
	ARGSCL==(1B9)
	ARGEDT==(1B10)

	C3ARG==4

ARGMOD:	POINT	4,TA,4
ARGNDP:	POINT	5,TA,30
ARGNSZ:	POINT	5,TA,35
ARGDSZ:	POINT	24,TA,35

CHGMOD:	POINT	4,CH,4		;[411] MODE TYPE
CHGNDP:	POINT	5,CH,30		; [411] NUMBER OF DECIMAL PLACES
CHGNSZ:	POINT	5,CH,35		; [411] SIZE FOR NUMERIC ITEMS
CHGDSZ:	POINT	24,CH,35		; [411] SIZE FOR NON-NUMERIC ITEMS
;ARG IS NUMERIC DATA ITEM

;SIMULATE PUT.A## BUT PUT VALUES
;  IN EOPTAB INSTEAD OF ON ASY FILE

ARGEN2:	MOVE	TC,CUREOP	;GET PTR TO OPERAND
	HRRZ	TB,(TC)		;NON-LITERAL SUBSCRIPT OR IN LINKAGE SECTION?
	ANDI	TB,700000
	CAIN	TB,AS.PAR
	TLO	CH,20		;YES, SET INDIRECT BIT FOR ARG PTR

ARGN2A:	MOVE	TC,CUREOP
	TSWF	FASUB		;IS IT SUBSCRIPTED?
	JRST	PUT.A2		;YES

PUT.A1:	HRR	CH,EBASEA
	SKIPE	EINCRA
	JRST	PUT.A3
	PUSHJ	PP,ARSUB2	;ZERO SUBSCRIPTS
	MOVEM	CH,(TC)
	SETZM	1(TC)
	POPJ	PP,		;RETURN

PUT.A3:	TLO	CH,ASINC
	PUSHJ	PP,ARSUB2	;ZERO SUBSCRIPTS
	MOVEM	CH,(TC)
	HRRZ	CH,EINCRA
	MOVEM	CH,1(TC)
	POPJ	PP,		;RETURN

PUT.A2:	LDB	TE,[POINT 3,EBASEA,20]
	CAIE	TE,TB.DAT
	JRST	PUT.A1

	TLO	CH,SXR
	HRR	CH,EINCRA
	PUSHJ	PP,ARSUB2	;ZERO SUBSCRIPTS
	MOVEM	CH,(TC)
	SETZM	1(TC)
	POPJ	PP,		;RETURN
;OPERAND IS A LITERAL

ARGEN4:	TSWT	FANUM		;IS IT NUMERIC?
	JRST	ARGEN7		;NO

	PUSHJ	PP,CONVNL##	;YES--CONVERT IT TO BINARY
	JUMPN	TD,ARGEN5	;2-WORD COMP?

	MOVE	CH,[AS.D1##,,1]	;NO--1 WORD
	PUSHJ	PP,PUTAS1
	TSWT	FLNEG		;NEGATIVE?
	SKIPA	CH,TC		;NO
	MOVN	CH,TC		;YES
	PUSHJ	PP,PUTAS1

	MOVSI	CH,ARG.##

	PUSHJ	PP,ARSUB1	;SET UP ASY OUTPUT
	AOS	EAS1PC
	POPJ	PP,		;RETURN

ARGEN5:	TSWF	FLNEG		;NEGATIVE?
	PUSHJ	PP,NEGATL##	;YES--NEGATE IT

	MOVE	CH,[AS.D2##,,2]
	PUSHJ	PP,PUTAS1
	MOVE	CH,TD
	PUSHJ	PP,PUTAS1
	MOVE	CH,TC
	PUSHJ	PP,PUTAS1

	MOVSI	CH,ARG.+11B30

	PUSHJ	PP,ARSUB1	;SET UP ASY OUTPUT
	MOVEI	TA,2
	ADDM	TA,EAS1PC
	POPJ	PP,		;RETURN
;ARGUMENT IS A NON-NUMERIC LITERAL

ARGEN7:	MOVSI	TA,ASCLIT##
	PUSHJ	PP,STASHI
	HRRZM	TE,CURLIT##

	MOVE	TA,CUREOP
	MOVE	TA,1(TA)
	PUSHJ	PP,LNKSET
	HRLI	TA,350700
	LDB	TD,TA
	MOVEI	TC,D7MODE##
	MOVEM	TC,EMODEB##
	MOVEM	TA,EBYTEA##
	SETZM	IMCONS##	;INCASE STILL SET
	PUSHJ	PP,VALLIT##
	PUSHJ	PP,STASHL
	SUB	TE,CURLIT
	HRRZS	CH,TE
	ADDM	TE,@CURLIT

	EXCH	CH,ELITPC
	ADDM	CH,ELITPC
	IORI	CH,AS.LIT##
	MOVEM	CH,EINCRA##
	MOVE	TE,[XWD ^D36,AS.MSC##]
	MOVEM	TE,EBASEA
	MOVEI	TE,D7MODE
	MOVEM	TE,EMODEA
	MOVE	CH,ARGLST+1
	JRST	ARGN1C
;ARGUMENT IS A FIGURATIVE CONSTANT

ARGEN8:	HRRZ	TE,EFLAGA##	;GET FIG. CONST. TYPE
	CAIN	TE,0		;TODAY?
	JRST	ARGN8F		;YES

	CAILE	TE,5		;IF NOT IN RANGE,
	MOVEI	TE,1		;  USE SPACES
	PUSHJ	PP,@FCLIST-1(TE)	;  OTHERWISE DISPATCH

	MOVE	CH,ARGLST
	MOVE	TC,CUREOP
	MOVEM	CH,(TC)
	JRST	ARGN8G

FCLIST:	EXP	ARGN8H	;SPACES
	EXP	ARGN8D	;ZEROES
	EXP	ARGN8E	;QUOTES
	EXP	ARGN8B	;HIGH-VALUES
	EXP	ARGN8A	;LOW-VALUES

;SUBROUTINE TO SET UP ASY FILE OUTPUT IN THE STYLE OF PUT.LD

ARSUB1:	MOVE	TC,CUREOP	;GET PTR TO CURRENT OPERAND
	HRRI	CH,AS.MSC	;SIMULATE PUT.LD##,
	TLO	CH,ASINC	;  BUT PUT ITEMS IN EOPTAB
	MOVEM	CH,(TC)		;  INSTEAD OF IN ASY FILE
	HRRZ	CH,EAS1PC
	IORI	CH,AS.PAR
	MOVEM	CH,1(TC)
	POPJ	PP,

;SUBROUTINE TO ZERO OUT SUBSCRIPTS IN EOPTAB ENTRY

ARSUB2:	MOVE	TC,CUREOP	;PTR TO CURRENT OPERAND
	MOVE	TE,2(TC)	;WORD AFTER ENTRY A ZEROED SUBSCRIPT?
	JUMPE	TE,CPOPJ	;YES
	LDB	TE,[POINT 1,(TC),9]	;OPERAND IN LINKAGE SECTION?
	JUMPN	TE,CPOPJ	;YES
	LDB	TE,[POINT 6,1(TC),17]	;GET # OF SUBSCRIPTS
	LSH	TE,1
	ADDI	TC,(TE)		;AIM PTR AT LAST SUBSCRIPT
ARS2A:	CAMN	TC,CUREOP	;ALL SUBSCRIPTS WIPED OUT?
	POPJ	PP,		;YES
	SETZM	(TC)		;NO, ZERO IT
	SUBI	TC,2		;BACK UP ONE ENTRY
	JRST	ARS2A
;ARGUMENT IS "TODAY"

ARGN8F:	MOVE	CH,ARGLST
	MOVE	TC,CUREOP
	MOVEM	CH,(TC)

	HRRZ	TB,1(TC)	;GET TEMP ADDRESS
	MOVEI	TD,^D12		;SIZE OF 'TODAY'
	MOVEI	TC,440600
	JRST	ARGN8C

;ARGUMENT IS 'LOW-VALUES'

ARGN8A:	TDCA	TB,TB

;ARGUMENT IS 'HIGH-VALUES'

ARGN8B:	HRROI	TB,-2

	MOVE	TA,[XWD OCTLIT##,1]
	PUSHJ	PP,STASHI
	MOVE	TA,TB
	PUSHJ	PP,STASHL
	HRRZ	TB,ELITPC
	IORI	TB,AS.LIT
	AOS	ELITPC
	POPJ	PP,

;ARGUMENT IS A FIGURATIVE CONSTANT  (CONT'D)

;ARGUMENT IS 'ZEROES'

ARGN8D:	PUSHJ	PP,AZRJ.##
	HRRZ	TB,EAZRJ##
	POPJ	PP,

;ARGUMENT IS 'QUOTES'

ARGN8E:	PUSHJ	PP,AQRJ.##
	HRRZ	TB,EAQRJ##
	POPJ	PP,

;ARGUMENT IS 'SPACES'

ARGN8H:	PUSHJ	PP,ASRJ.##
	HRRZ	TB,EASRJ##
	POPJ	PP,
;COMMON EXIT FOR FIG CONSTANT ROUTINES

ARGN8G:	MOVE	TD,[EXP 1B2+1]	;SIZE + 'FIG. CONST.'
	MOVEI	TC,440700

ARGN8C:	MOVE	TA,[XWD BYTLIT,2]
	PUSHJ	PP,STASHI
	HRRZI	TA,AS.MSC
	PUSHJ	PP,STASHL
	HRLZ	TA,TC
	HRR	TA,TB
	PUSHJ	PP,STASHL

	HRRZ	CH,ELITPC
	IORI	CH,AS.LIT
	AOS	ELITPC
	MOVE	TC,CUREOP
	MOVEM	CH,1(TC)
	MOVE	TA,[XWD XWDLIT##,2]
	PUSHJ	PP,STASHI
	MOVE	TA,TD
	HRRI	TA,AS.CNB##
	PUSHJ	PP,STASHL
	MOVS	TA,TD
	HRRI	TA,AS.CNB##
	PUSHJ	PP,STASHL
	AOS	ELITPC
	POPJ	PP,		;RETURN
;ARGUMENT IS A PROCEDURE NAME

ARGEN9:	TLNN	TE,FLOBIT
	JRST	ARGN9A

	ANDI	TE,77777
	ADD	TE,FLOLOC##
	HRRZ	TE,0(TE)
	LDB	TD,[POINT 3,TE,20]
	CAIE	TD,TB.PRO
	JRST	ARGN9B

ARGN9A:	ANDI	TE,77777
	MOVEI	CH,AS.PRO##(TE)
	HRLI	CH,ARG.+17B30
	MOVE	TC,CUREOP	;GET PTR TO CURRENT OPERAND
	MOVEM	CH,(TC)
	SETZM	1(TC)
	POPJ	PP,		;RETURN

ARGN9B:	MOVEI	DW,E.317
	PUSHJ	PP,OPNFAT##
ARGN9C:	MOVE	TC,CUREOP	;GET PTR TO CURRENT OPERAND
	SETZM	(TC)		;SIGNAL NOTHING TO OUTPUT TO ASY FILE
	SOS	ARGCTR		;DON'T COUNT THIS ARG
	POPJ	PP,		;RETURN
;SET UP SUBSCRIPTS FOR ARGS THAT REQUIRE THEM
;  ALSO SET UP TODAY IF IT IS USED AS AN ARG

SARG:	MOVSM	TC,OPERND
	LDB	TE,[POINT 3,1(TC),20]	;IS IT DATA-NAME?
	CAIE	TE,TB.DAT
	JRST	SARG3		;NO

	MOVEI	LN,EBASEA	;YES--SET UP PARAMETERS
	PUSHJ	PP,SETOPN
	TSWF	FERROR		;IF ERROR,
	JRST	SARG4		;  FORGET IT

	PUSHJ	PP,SUBSCA	;SEE IF IT IS
	HLRZ	TC,OPERND	; GET OPERAND ADR OF ARG [254]
	HLLZS	0,(TC)		; TURN OFF THE SOURCE LINE # [254]
	TSWT	FASUB		;  SUBSCRIPTED
	JRST	SARG4		;NO--FORGET THIS ONE

;[565] IF NUMERIC EDITED, SET UP EXTERNAL SIZE IN ESIZEA
	MOVE	TA,ETABLA##	;[565] GET EXTERNAL SIZE
	PUSHJ	PP,LNKSET	;[565]  FOR THIS DATANAME
	LDB	TE,DA.EDT##	;EDITED?
	 JUMPE	TE,SARG2	;NO, SKIP THE HACK
	LDB	TE,DA.EXS	;[565]
	MOVEM	TE,ESIZEA	;[565] SAVE IN ESIZEA
;;**** BEWARE -- THE FOLLOWING IS A HACK ! ****
;THE FLAG "GNFCS",WHICH USUALLY MEANS "FIG. CONST- SPACES" WILL
; BE SET TO INDICATE THAT THE ARGUMENT IS NUMERIC EDITED. THIS IS
; OK FOR THE DURATION OF THE "CALL" STATEMENT CODE GENERATION BECAUSE
; THE "GNLIT" FLAG (= LITERAL OR FIG. CONST) IS ALWAYS TESTED FIRST, SO
; THE FAKE "GNFCS" AND REAL "GNFCS" CASES WILL BE HANDLED IN DIFFERENT CODE.
	MOVSI	TE,GNFCS	;GET A FLAG TO INDICATE "NUMERIC EDITED"
	IORM	TE,(TC)		; ARGUMENT

SARG2:	MOVE	EACC,EAS1PC##	;GET %PARAM ADDRESS
	IORI	EACC,AS.PAR##
	AOS	EAS1PC

	HLRZ	TC,OPERND
	HRRM	EACC,0(TC)
	MOVE	CH,MOVSAC##
	PUSHJ	PP,PUTASY
	HRRZ	CH,EACC
	PUSHJ	PP,PUTASN

	MOVE	CH,[XWD AS.OCT##,1]
	PUSHJ	PP,PUTAS1##
	MOVEI	CH,0
	PUSHJ	PP,PUTAS1

	HRRZ	TE,EMODEA
	CAIE	TE,C3MODE	;[411] IF COMP-3
	CAIG	TE,DSMODE
	PUSHJ	PP,SARG5

	MOVSI	TD,GNNOTD
	MOVE	TE,ESIZEA
	DPB	TE,ACSIZE##
	MOVE	TE,EMODEA
	DPB	TE,ACMODE##
	HRR	TD,EDPLA
	LDB	TE,[POINT 6,1(TC),17]
	MOVEM	TD,1(TC)

SARG2A:	MOVEI	TC,2(TC)
	SOJL	TE,CPOPJ
	SETZM	0(TC)
	JRST	SARG2A
;OPERAND IS NOT A DATA NAME

SARG3:
IFN ANS68,<
	MOVE	TE,0(TC)	;GET FIRST WORD OF OPERAND
	TLNE	TE,GNLIT	;IS IT EITHER A LITERAL OR FIG. CONST.?
	TLNN	TE,GNFIGC	;YES--FIG. CONST.?
	JRST	SARG4		;NO

	TLNN	TE,GNTODY	;IS IT "TODAY"?
	JRST	SARG4		;NO

	MOVEI	TE,2		;YES--RESERVE
	PUSHJ	PP,GETEMP##	;  2 TEMP WORDS
	HRRM	EACC,1(TC)	;SAVE THE TEMP ADDRESS

	MOVEI	CH,TODAY.##	;GENERATE <PUSHJ 17,TODAY.>
	PUSHJ	PP,PUT.PJ
 IFN BIS,<
	PUSHJ	PP,PUTASA
	MOVE	CH,[DMOVM.##,,AS.MSC]
 >
 IFE BIS,<
	MOVE	CH,[XWD MOVEM.,AS.MSC]	;GENERATE <MOVEM 0,%TEMP>
 >
	PUSHJ	PP,PUTASY
	HRRZ	CH,EACC
	PUSHJ	PP,PUTASN
 IFE BIS,<
	MOVE	CH,[XWD MOVEM.+AC1,AS.MSC]	;GENERATE <MOVEM 1,%TEMP+1>
	PUSHJ	PP,PUTASY
	MOVEI	CH,1(EACC)
	PUSHJ	PP,PUTASN
 >
>

;GO TO NEXT OPERAND

SARG4:	PUSH	PP,CUREOP	;SAVE CUREOP (TO MAKE THIS END LIKE SARG2A)
	PUSHJ	PP,BMPEOP##
	  JFCL			;IGNORE SKIP RETURNS
	MOVE	TC,CUREOP	;SET TC TO NEW ARG
	POP	PP,CUREOP	;RESET CUREOP TO ARG JUST DONE
	POPJ	PP,
;WRITE OUT PARAMETER WORD FOR SUBSCRIPTED DISPLAY ITEM

SARG5:	AOS	EAS1PC
	MOVE	CH,	[XWD	AS.OCT##,1]	; [411] WRITE IT OUT IN OCTAL.
	PUSHJ	PP,PUTAS1		; [411] PUT INTO ASSEMBLY FILE
	SETZI	CH,			; [411] BUILD IT IN TA.
	MOVE	TE,	EMODEA##	; [411] SET UP THE MODE FIELD.
	CAIN	TE,	C3MODE##	; [411] COMP3?
	MOVEI	TE,	C3ARG-1	; [411] YES SET IT UP
	ADDI	TE,	1	; [411] SET FOR ARGUMENT
	DPB	TE,	CHGMOD	; [411] PUT INTO PARM WORD
;[565] IF NUMERIC EDITED, SET NUMERIC BIT
	MOVE	TE,	0(TC)	;[565] GET FLAG BITS FOR OPERAND
	TLNE	TE,	GNOPNM	;[565] IF NUMERIC EDITED,
	SWON	FANUM		;[565] SET NUMERIC BIT

	TSWT	FANUM		; [411] NUMERIC?
	JRST	SARG5B		; [411] NOT NUMERIC GO ON
;	TLO	TA,	ARGNUM	; [411] SET NUMERIC IN PARAM WORD
	TLO	CH,	ARGNUM	;[475] SET NUMERIC IN PARAM WORD

;  NUMERIC ARG.

	TLNE	TE,	GNFCS	;(SEE HACK IN SARG) IF NUMERIC EDITED,
	TLO	CH,	ARGEDT	;SET EDITED BIT IN PARAM WORD
	TSWF	FASIGN 			; [411] TRANSFER THE SIGN FLAG.
;	TLO	TA,	ARGSGN	; [411] SET SIGN BIT IN PARAM WORD
	TLO	CH,	ARGSGN		;[475] DECIMAL PLACES?
	MOVE	TE,	EDPLA##		; [411] DECIMAL PLACES?
	JUMPGE	TE,	SARG5A		; [411] IF IT'S POSITIVE, THEY ARE REAL
	MOVMS		TE		; [411] IT'S NEGATIVE - IT'S ACTUALLY
					; [411]  THE SCALE FACTOR.
;	TLO	TA,	ARGSCL		; [411] NOTE IT.
	TLO	CH,	ARGSCL		;[475] STASH THE SCALE FACTOR (OR
SARG5A:	DPB	TE,	CHGNDP		; [411] STASH THE SCALE FACTOR (OR
					; [411]  OR DECIMAL PLACES.)
	MOVE	TE,	ESIZEA##	; [411] GET THE SIZE.
	DPB	TE,	CHGNSZ		; [411] STASH IT.
	JRST		PUTAS1		; [411] GO STASH THE WORD.

;  NON-NUMERIC ARG.

SARG5B:	MOVE	TE,	ESIZEA##	; [411] GET THE SIZE.
	DPB	TE,	CHGDSZ		; [411] STASH IT.
	JRST		PUTAS1		; [411] GO STASH THE WORD.
;TABLE OF ARGUMENT TYPES FOR "USING"

ARGLST:	XWD	ARG.+10B30+ASINC,AS.MSC		;SIXBIT
	XWD	ARG.+10B30+ASINC,AS.MSC		;ASCII
	XWD	ARG.+10B30+ASINC,AS.MSC		;EBCDIC
	XWD	ARG.,0				;1-WORD COMP
	XWD	ARG.+11B30,0			;2-WORD COMP
	XWD	ARG.+2B30,0			;FL.PT.
	XWD	ARG.+10B30+ASINC,AS.MSC	;COMP-3


;MISCELLANEOUS CONSTANTS

AC16==16B30
AC17==17B30

ASINC==1B19

ARGOP.==46	;OPERATOR CODE FOR "ARG"

AC1==1B30

MACRO==1B9		;MACRO FLAF
F40==1B10		;FORTRAN-IV FLAG
USINGF==1B11		;USING FLAG FOR CALL AND ENTER
CALLF==1B12		;CALL FLAG
F10==1B13		;FORTRAN FLAG (NEW FORTRAN)

PDENTF==1B9		;PROC DIV ENTRY POINT FLAG

GOBAKF==1B9		;GOBACK
EXPGMF==1B10		;EXIT PROGRAM
SUBTTL	GENERATE "CALL"

IFN ANS74,<
ENTRGN:
>
CALLGN:	SWOFF	FEOFF1		;CLR FLAGS
	SETZM	ARGCTR##	;CLR ARG CTR
	TLNN	W1,(USINGF)	;THIS CALL HAVE ARGS?
	JRST	CALL1		;NO

	MOVEM	W1,OPLINE##	;SAVE SRC POSITION AND FLAGS OF CALL
	PUSHJ	PP,READEM##	;GET USING OPERATOR
	MOVEM	EACA,EOPNXT
	EXCH	W1,OPLINE	;STASH USING & GET BACK CALL

	MOVEM	EACA,EOPNXT
	HRRZ	TC,EOPLOC
	ADDI	TC,3
	CAIL	TC,(EACA)
	POPJ	PP,		;[1002] ARG MISSING, GIVE UP, DIAGNOSTIC PUT OUT BY DTREE

CALL2:	MOVEM	TC,CUREOP

	TLNN	W1,(CALLF)	;CALL OR ENTER?
	JRST	CALL8		;ENTER, NO SPECIAL CHECK ON ARGS

	HRRZ	TA,1(TC)	;GET PTR TO OPERAND
	LDB	TB,[POINT 3,TA,20]	;DATAB ITEM?
	CAIE	TB,CD.DAT
	JRST	CALL8		;NO, LET LITERALS PASS
	PUSHJ	PP,LNKSET
	LDB	TB,DA.RES##	;IS ITEM LEFT JUSTIFIED IN A WORD?
	CAIN	TB,44
	JRST	CALL8		;YES, IT IS GOOD
	MOVEI	DW,E.396	;NO, ?MUST BE WORD ALIGNED
	PUSHJ	PP,OPNFAT

CALL8:	MOVE	TC,CUREOP	;GET BACK OPERAND PTR
	PUSHJ	PP,SARG		;SET UP SUBSCRIPTS FOR CURRENT ARG
	MOVE	TC,CUREOP
	PUSHJ	PP,ARG		;SET ARG LIST FOR LATER OUTPUT

CALL3:	MOVEI	TC,2		;BUMP UP TO NEXT EOPTAB ENTRY
	ADDB	TC,CUREOP
	MOVE	EACA,EOPNXT	;END OF LIST?
	CAIL	TC,(EACA)
	JRST	CALL1		;YES

	SKIPE	(TC)		;NO, THIS A WIPED OUT SUBSCRIPT?
	JRST	CALL2		;NO, PROCESS IT
	JRST	CALL3		;YES, TRY NEXT ENTRY
CALL1:	HRRZ	TA,EOPLOC	;AIM AT SUBPROG NAME
	MOVEI	TB,1(TA)	;RESET CUREOP
	MOVEM	TB,CUREOP
	MOVE	TA,2(TA)	;GET EXTAB LINK
IFN ANS74,<
	LDB	TB,[POINT 3,TA,20]
	CAIN	TB,CD.DAT	;SEE IF JUST DATAB LINK
	JRST	CALL9		;YES IT IS
>
	PUSHJ	PP,LNKSET
	LDB	TB,EX.ENT##	;ENTRY?
	MOVEI	DW,E.398
	JUMPN	TB,OPNFAT	;IF SO, ?ILLEGAL CALL

	MOVE	TA,[OCTLIT,,1]	;PUT NEGATIVE ARG CNT IN LITERALS
	PUSHJ	PP,STASHI	;  IN LEFT HALF OF -1(16)
	MOVN	TA,ARGCTR
	HRLZI	TA,(TA)
	PUSHJ	PP,STASHL
	AOS	ELITPC

	MOVE	CH,[MOVEI.##+ASINC+AC16,,AS.MSC]	;PUT OUT "MOVEI 16,%LIT00+N"
	PUSHJ	PP,PUTASY
	HRRZ	CH,ELITPC
	IORI	CH,AS.LIT
	PUSHJ	PP,PUTASN

	HRRZ	TA,EOPLOC##	;GET CALL OPERAND'S LINK
	MOVE	CH,2(TA)	;PUT OUT "PUSHJ 17,ENTRY-ADDR"
	ANDI	CH,77777
	IORI	CH,AS.EXT##
	TLO	CH,PUSHJ.##+AC17
	PUSHJ	PP,PUTASY

CALL1A:	TSWT	FAS3		;ARE WE IN NON-RESIDENT SEGMENT?
	JRST	CALL7		;NO--GO TO "USING"

	MOVE	TA,2(TA)	;YES--GET OPERAND LINK
	PUSHJ	PP,LNKSET	;GET EXTAB ADDRESS
	SETO	TE,		;SET "REFERENCED IN NON-RES"
	DPB	TE,EX.NRS##

CALL7:	TLNE	W1,(USINGF)	;IF THERE WERE NO ARGS OR THERE
	TSWF	FFATAL		; WAS A FATAL ERROR, DON'T WRITE
	JRST	CALL6		; THE ARG LIST OUT.
;PUT ARG LIST FOR CALL IN LITERALS

	HRRZ	TC,EOPLOC	;RESET CUREOP TO TOP OF LIST
	ADDI	TC,3

CALL4:	MOVEM	TC,CUREOP
	SKIPN	CH,(TC)		;OUTPUT ARG LIST TO LITFIL
	JRST	CALL5
	MOVE	TA,[XWDLIT##,,2]
	PUSHJ	PP,STASHI
	HLRZ	TA,CH
	ANDI	TA,740		;GET AC FIELD ONLY
	CAIN	TA,2B30		;CONVERT TO NEW ARG TYPE CODES
	MOVEI	TA,4B30
	CAIN	TA,0B30
	MOVEI	TA,2B30
	CAIN	TA,10B30
	MOVEI	TA,15B30
	CAIN	TA,17B30
	MOVEI	TA,7B30
	TLNE	CH,20		;INDIRECT BIT ON?
	TRO	TA,20		;YES, SET IN TA TOO
	PUSHJ	PP,STASHL
	HRRZ	TA,(TC)
	HRL	TA,1(TC)
	PUSHJ	PP,STASHL
	AOS	ELITPC

CALL5:	ADDI	TC,2		;ON TO NEXT ARG
	MOVE	EACA,EOPNXT	;END OF LIST?
	CAIGE	TC,(EACA)
	JRST	CALL4		;NO
	POPJ	PP,		;YES

;NO ARGS

CALL6:	MOVE	TA,[OCTLIT,,1]	;0 TO 1ST ITEM OF ARGLIST
	PUSHJ	PP,STASHI
	MOVEI	TA,0
	PUSHJ	PP,STASHL
	AOS	ELITPC
	POPJ	PP,
;HERE FOR ANS-74 CALL WITH SUBROUTINE UNKNOWN AT COMPILE TIME

IFN ANS74,<
CALL9:	PUSHJ	PP,LNKSET
	MOVE	TC,CUREOP	;POINT TO IT
	PUSHJ	PP,SETOPA##	;GET ARG
	MOVE	TE,[EBASEA,,EBASEB]
	BLT	TE,EBASBX	;COPY 
	MOVEI	TE,D6MODE##	;FORCE SIXBIT
	MOVEM	TE,EMODEB	;AS TARGET
	MOVEI	TE,6		;6 OR LESS CHARS.
	MOVEM	TE,ESIZEB##	;LEFT JUSTIFIED
	MOVEI	TE,1		;GET 1 WORD
	PUSHJ	PP,GETEMP##	; OF TEMP STORAGE
	MOVEM	EACC,EINCRB	;POINT "B" AT TEMP
	MOVE	TA,[^D36,,AS.MSC]
	MOVEM	TA,EBASEB
	SWOFF	FBSUB
	PUSH	PP,EINCRB	;[1041] SAVE SINCE MXX. MAY DESTROY IT
	PUSHJ	PP,MXX.##	;GO DO MOVE
	POP	PP,EINCRB	;[1041] RESTORE EINCRB
	MOVE	TA,[OCTLIT,,1]	;PUT NEGATIVE ARG CNT IN LITERALS
	PUSHJ	PP,STASHI	;  IN LEFT HALF OF -1(16)
	MOVN	TA,ARGCTR
	HRLZI	TA,(TA)
	PUSHJ	PP,STASHL
	AOS	ELITPC
	MOVE	CH,[MOVEI.##+ASINC+AC16,,AS.MSC]	;PUT OUT "MOVEI 16,%LIT00+N"
	PUSHJ	PP,PUTASY
	HRRZ	CH,ELITPC
	IORI	CH,AS.LIT
	PUSHJ	PP,PUTASN
	HRRZI	CH,S.CALL##
	HRLI	CH,AC17+PUSHJ.
	PUSHJ	PP,PUTASY	;PUSHJ 17,S.CALL
	MOVSI	CH,ARG.##
	PUSHJ	PP,PUT.B	;ARG	%TEMP+N
	JRST	CALL1A		;NOW FOR REST OF IT
>
SUBTTL	GENERATE AN "ENTRY"

NTRYGN:	MOVE	CH,	[XWD	AS.SMC##,1]	;TELL PHASE G TO PUT
	PUSHJ	PP,	PUTASN			; OUT A FORM FEED
	MOVE	CH,	[XWD	AS.PFF##,AS.MS1##]	; HERE.
	PUSHJ	PP,	PUTASN

	TLNN	W1,(PDENTF)	;THIS THE PROCEDURE DIVISION ENTRY?
	JRST	NTRY1		;NO, PUT OUT JRST OVER ENTRY CODE

	MOVE	CH,EAS1PC	;YES, GET A %PARAM LOC FOR CALL FLAG
	AOS	EAS1PC
	IORI	CH,AS.PAR
	HRRZM	CH,RETPTR##
	PUSHJ	PP,PUTOC0	;OCTAL 0 TO AS1FIL

	MOVE	CH,EAS1PC	;AND A %PARAM LOC FOR THE CALLER'S ARG PTR
	AOS	EAS1PC
	IORI	CH,AS.PAR
	HRRZM	CH,ARGPTR##
	PUSHJ	PP,PUTOC0	;OCTAL 0 TO AS1FIL
	JRST	NTRY2

NTRY1:	PUSHJ	PP,GETTAG##	;GET TAG FOR JUMP OVER ENTRY CODE
	HRRZM	CH,ENTAGS##	;SAVE
	HRLI	CH,JRST.##	;<JRST %TAG>
	HRRZ	TA,CH		;GET TAG NUMBER
	PUSHJ	PP,REFTAG##	;REFERENCE IT
	PUSHJ	PP,PUTASY

NTRY2:
	;PUT OUT ENTRY POINT INFORMATION AREA.
	;[74]	LINK TO OTHER ENTRY POINTS IN EXTERNAL SUBROUTINES
	;	XWD	PROGRAM'S-BASE-ADDRESS,MAIN-ENTRY-POINT
	;	SIXBIT	"ENTRY-NAME"
	;
	;	THIS LIST CAN BE EXPANDED IN THE NEGATIVE DIRECTION
	;	WITHOUT AFFECTING COMPATABILITY OF EARILER VERSIONS

IFN ANS74,<
	MOVE	CH,[AS.OCT,,1]		;ALLOCATE SPACE FOR LINK WORD
	PUSHJ	PP,PUTASN
	SETZ	CH,			;JUST PUT OUT 0
	PUSHJ	PP,PUTASY
>
	MOVE	CH,[AS.XWD##,,1]	;PUT OUT XWD	0,MAIN-ENTRY
	PUSHJ	PP,PUTASN
	MOVE	CH,	[XWD	AS.BSA##,AS.MS1##]	;LEFT IS THE PROGRAM'S
							; BASE ADDRESS.
	PUSHJ	PP,PUTASN
	HRRZ	TA,EOPLOC	;GET EXTAB LINK FOR ENTRY OPERAND
	HRRZ	CH,2(TA)
	ANDI	CH,77777	;SUBSTITUTE AS.EXT FOR CD.EXT
	IORI	CH,AS.EXT

	PUSH	PP,CH		;SAVE CH FOR A FEW MINUTES
	TLNN	W1,(PDENTF)	;PROCEEDURE DIVISION ENTRY?
	JRST	.+3		;NO
	MOVEM	CH,PRGEAD##	;YES - SAVE FOR LATER ENTRIES
	TDZA	CH,CH		;0 FOR MAIN ENTRY
	MOVE	CH,PRGEAD##	;GET MAIN ENTRY POINT
	PUSHJ	PP,PUTASY	;OUTPUT RIGHT HALF OF XWD

	;NOW FOR THE NAME
	MOVE	CH,[AS.SIX,,1]	;IN SIXBIT
	PUSHJ	PP,PUTASN
	HRRZ	TA,EOPLOC	;GET POINTER TO HLDTAB  ENTRY CONTAINING
	HRRZ	TA,2(TA)	;THE ENTRY NAME
	PUSHJ	PP,LNKSET
	LDB	TB,EX.HLD
	HRRZ	TA,HLDLOC##
	ADDI	TA,2(TB)	;START OF THE NAME - USE ONLY FIRST
	MOVE	CH,(TA)		;SIX CHARACTERS
	PUSHJ	PP,PUTASY

	POP	PP,CH		;RESTORE CH

	HRLI	CH,AS.ENT##	;OUTPUT ENTRY, BUT DON'T BUMP PC
	PUSHJ	PP,PUTASN

	TLNN	W1,(PDENTF)	;PRO. DIV. ENTRY?
	JRST	NTRY6		;NO
	MOVE	CH,EAS2PC##	;YES, SAVE PC
	MOVEM	CH,PRGENT##

NTRY6:	PUSHJ	PP,PUTASA##	;GEN FUNNY UNOPTIMIZABLE "SKIPA"
	HRLZI	CH,XSKPA.##	;OUTPUT "SKIPA" OVER THE ENTRY PARAMETER
	PUSHJ	PP,PUTASY

	MOVE	CH,[AS.XWD,,1]	;OUTPUT "XWD %SUBRLIST,FILES."
	PUSHJ	PP,PUTASN
	HRLZ	CH,SUBLST##
	TLO	CH,AS.LIT
	HRRI	CH,AS.MSC
	PUSHJ	PP,PUTASY
	MOVE	CH,[AS.FLS##,,AS.MSC]
	PUSHJ	PP,PUTASN

	MOVE	CH,[ASINC+SKIPE.##,,AS.MSC]	;OUTPUT "SKIPE %CALLFLAG"
	PUSHJ	PP,PUTASY
	HRRZ	CH,RETPTR
	PUSHJ	PP,PUTASN

	MOVEI	CH,ILLC%##	;RECURSIVE CALL CHECK
	PUSHJ	PP,PUT.PJ

	MOVE	CH,[ASINC+SETOM.##,,AS.MSC]	;"SETOM %CALLFLAG"
	PUSHJ	PP,PUTASY
	HRRZ	CH,RETPTR
	PUSHJ	PP,PUTASN

	MOVE	CH,[ASINC+AC16+MOVEM.##,,AS.MSC]	;"MOVEM 16,%ARGPTR"
	PUSHJ	PP,PUTASY
	HRRZ	CH,ARGPTR
	PUSHJ	PP,PUTASN

	HRRZ	TA,EOPLOC	;GET ENTRY ADDRESS
	HRR	CH,2(TA)
	ANDI	CH,77777
	IORI	CH,AS.EXT
	TLO	CH,MOVEI.##+AC16		;
	PUSHJ	PP,PUTASY

	MOVEI	CH,PUTF%##
	PUSHJ	PP,PUT.PJ

	SKIPE	PRODSW##	;/P ON?
	JRST	NTRY4		;YES, NO TRACE CODE

	HRRZ	TA,EOPLOC	;MAKE PTR TO HLDTAB ENTRY CONTAINING
	HRRZ	TA,2(TA)	;  NAME OF ENTRY
	PUSHJ	PP,LNKSET
	LDB	TB,EX.HLD##
	HRRZ	TA,HLDLOC##
	ADDI	TA,(TB)
	MOVEM	TA,CURHLD##

	MOVEI	CH,C.TRCE##
	PUSHJ	PP,PUT.PJ
	MOVE	CH,[AS.XWD,,1]
	PUSHJ	PP,PUTASN
	HRRZ	TA,CURHLD	;LH = COUNT OF NAME WORDS
	LDB	CH,HL.QAL##
	MOVEM	CH,CURNAM##	;SAVE COUNTER
	ADDI	CH,1001		;PLUS ENTRY FLAG AND COUNT OF XWD ARG
	TLNE	W1,(PDENTF)	;IS PROGRAM-ENTRY FLAG?
	ADDI	CH,1000		;YES, MAKE PROGRAM-ENTRY FLAG
	PUSHJ	PP,PUTASN
	MOVEI	CH,0		;RIGHT HALF = 0
	PUSHJ	PP,PUTASY

	HRLZI	CH,AS.SIX##	;PUT OUT SIXBIT NAME OF ENTRY
	HRR	CH,CURNAM
	PUSHJ	PP,PUTASN

	AOS	CURHLD		;AIM AT LAST BASIC HLDTAB WORD
	MOVN	TC,CURNAM	;MAKE CTR
	HRLM	TC,CURHLD

NTRY7:	SKIPL	TA,CURHLD	;GET CTR-PTR
	JRST	NTRY4		;ALL DONE
	AOBJP	TA,.+1		;BUMP CTR-PTR
	MOVEM	TA,CURHLD	;SAVE NEW COPY
	MOVE	CH,(TA)		;GET NAME WORD
	PUSHJ	PP,PUTASY	;TO ASY FILE
	JRST	NTRY7

NTRY4:	TLNN	W1,(USINGF)	;ANY ARGS?
	JRST	NTRY5

;CODE TO PICK UP ARGS

	MOVEM	W1,OPLINE	;SAVE ENTRY OP
	PUSHJ	PP,READEM	;READ IN ARG LIST
	MOVEM	EACA,EOPNXT
	EXCH	W1,OPLINE

	MOVE	CH,[ASINC+ARGS.##,,AS.MSC]	;OUTPUT "ARGS. 0,%LIT"
	PUSHJ	PP,PUTASY
	HRRZ	CH,ELITPC
	AOJ	CH,		;AIM AT LIT LOC AFTER ARG COUNT WORD
	IORI	CH,AS.LIT
	PUSHJ	PP,PUTASN

	PUSHJ	PP,DUMARG	;SET UP ARG LIST PTRS

NTRY5:	TLNE	W1,(PDENTF)	;PROC DIV ENTRY POINT?
	JRST	NTRY8		; [324] YES, JUMP AROUND DECLARITIVES IF ANY
	HRRZ	CH,ENTAGS	;OUTPUT "%TAG:"
	JRST	PUTTAG##	;AND RETURN

NTRY8:	MOVE	CH,PROGST##	;GET START ADDRESS
	TLZN	CH,-1		;IN NON-RESIDENT SECTION?
	JRST	NTRY3		;NO
	PUSHJ	PP,PUTTAG	;YES, THIS BECOMES START ADDRESS
	MOVE	CH,[OVLAY.##+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	MOVE	TA,[XWDLIT,,2]
	PUSHJ	PP,STASHI
	HLRZ	TA,PROGST	;GET NON-RES ADDRESS
	PUSHJ	PP,STASHL
	TRC	TA,600000	;CHANGE 2 TO 4
	PUSHJ	PP,LNKSET	;GET PROTAB ADDRESS
	LDB	TA,PR.PRI##	;GET LEVEL
	HRLZ	TA,TA
	HRRI	TA,AS.CNB
	PUSHJ	PP,STASHL
	AOS	CH,ELITPC	;ACCOUNT FOR LITERAL
	MOVEI	CH,AS.LIT-1(CH)	;
	HRRZS	PROGST		;JUST INCASE
IFN ANS68,<
	JRST	PUTASN		;FINISH OFF
>
IFN ANS74,<
	PUSHJ	PP,PUTASN	;FINISH OFF
	JRST	NTRY9
>

NTRY3:	SKIPN	DECLR.##	;[324] DOES THIS SUBPROGRAM HAVE DECLARITIVES
IFN ANS74,<
	SKIPE	RELKEY##	;OR RELATIVE KEY CONVERSION REQUIRED?
	CAIA			;YES TO AT LEAST ONE OF THEM
>
	POPJ	PP,		; [324] NO ALL DONE
	HRRZ	CH,PROGST##	; [324] YES NEED TO JUMP AROUND DECLARITVES
	HRLI	CH,JRST.	; [324] JRST TO START OF SUBPROGRAM BEYOND   NON-DECLARIVES SECTION.
	PUSHJ	PP,PUTASY	;[324] PUT IN ASY FILE
	HRRZ	TA,PROGST	;GET TAG
IFN ANS68,<
	JRST	REFTAG##	;REFERENCE IT AND RETURN
>
IFN ANS74,<
	PUSHJ	PP,REFTAG##	;REFERENCE IT
NTRY9:	SKIPN	RELKEY		;NEED TO CONVERT?
	POPJ	PP,		;NO
				;YES
				;FALL THROUGH
	MOVE	CH,[XWD	AS.SMC##,1]	;TELL PHASE G TO PUT
	PUSHJ	PP,PUTASN			; OUT A FORM FEED
	MOVE	CH,[XWD	AS.PFF##,AS.MS1##]	; HERE.
	PUSHJ	PP,PUTASN
	SWOFF	FASUB+FBSUB	;JUST INCASE
	SETZM	RELKEY		;ONLY DO IT ONCE

;SCAN DATAB FOR NON-COMP DEPENDING ITEMS


	MOVEI	TA,1
	JRST	CKDT.T		;MAKE TEST

CKDT.0:	LDB	TB,DA.PWA	;PIC WORD ALLOCATED?
	LDB	TE,DA.SUB	;OR WORDS 8 & 9 ALLOCATED?
	IOR	TB,TE
	JUMPE	TB,CKDT.Z	;NO, SO NO DEPENDING ITEM
	LDB	TB,DA.DEP##	;DEPENDING ITEM?
	JUMPE	TB,CKDT.Z	;NO
	LDB	TB,DA.DCR##	;SEE IF NEEDED
	JUMPE	TB,CKDT.Z	;NO
	PUSHJ	PP,GETTAG##	;GET NEXT TAG
	TRNN	CH,077777	;WE CANNOT USE 0
	JRST	.-2		;SO GET NEXT TAG
	DPB	CH,DA.DCR	;DEPENDING CONVERSION ROUTINE
	PUSHJ	PP,PUTTAG##	;OUTPUT TAG TO ASYFIL
;	LDB	TD,DA.DEP	;GET REAL DEPENDING ITEM
;	SETZ	TE,		;FAKE IT OUT
;	MOVEI	TC,TE		; SINCE WE DON'T HAVE REAL OPERAND

	PUSH	PP,	W1		;SAVE W1
	PUSH	PP,	W2		; AND W2.
	PUSH	PP,	OPERND##	;SAVE OPERND TOO. (IN CASE IT'S
					; IN THE LINKAGE SECTION.)

	LDB	W2,	DA.DEP##	;GET THE DEPENDING ITEM.
	MOVEI	TA,	(W2)		; AND POINT AT IT.
	PUSHJ	PP,	LNKSET##

	HRLZI	W1,	(1B0)		;SET THE OPERAND FLAG.

	LDB	TD,	DA.SYL##	;SET THE SYNC FLAGS.
	DPB	TD,	[POINT 1,W1,5]
	LDB	TD,	DA.SYR##
	DPB	TD,	[POINT 1,W1,6]

	LDB	TD,	DA.CLA##	;SET THE NUMERIC FLAG.
	CAIN	TD,	%CL.NU
	TLO	W1,	(1B7)

	LDB	TD,	DA.JST##	;SET THE JUSTIFIED FLAG.
	DPB	TD,	[POINT 1,W1,8]

	LDB	TD,	DA.LKS##	;SET THE LINKAGE SECTION FLAG.
	DPB	TD,	[POINT 1,W1,9]

	LDB	TD,	DA.USG##	;SET THE USAGE.
	DPB	TD,	[POINT 4,W1,13]

	PUSHJ	PP,	PUSH12##	;STASH THE INFO IN EOPTAB.

	HRRZI	TC,	-1(EACA)	;POINT AT THE EOPTAB ENTRY.

	MOVEM	TC,	CUREOP		;MAKE IT THE CURRENT ENTRY.

	HRLZM	TC,	OPERND##	;MAKE IT THE CURRENT OPERAND TOO.

	MOVEI	LN,EBASEA	;[752] SET IT UP AS "A" OPERAND
	PUSHJ	PP,SETOPN##	;[752] CANNOT USE SETOPA INCASE OF ERROR
	TSWF	FERROR		;[752] IF ERROR?
	JRST	CKDT.E		;[752] GIVE UP
	MOVEI	TE,10		;USE AC'S 10  OR 7 & 10
	MOVEM	TE,EAC##
IFN BIS,<
	SETOM	ESAFLG##	;DON'T MOVE FROM 10 TO 10
>
	SETZM	ECARRY##
	PUSHJ	PP,MXAC.##	;GET IT INTO ACCS
IFN BIS,<
	SETZM	ESAFLG
>
	MOVE	CH,[MOVMM.##+ASINC+,,AS.MSC]
	MOVE	TE,EAC
	DPB	TE,CHAC##	;INCASE BIS DP
	PUSHJ	PP,PUTASY##	;OUTPUT MOVMM 10,
	MOVEI	CH,AS.PAR##	;+ %PARAM+0
	PUSHJ	PP,PUTASN
	MOVSI	CH,POPJ.+AC17
	PUSHJ	PP,PUTASY	;END WITH POPJ 17,

CKDT.E:	POP	PP,	OPERND##	;[752] RESTORE OPERND.
	POP	PP,	W2		;RESTORE W2
	POP	PP,	W1		; AND W1.

	MOVE	EACA,	EOPNXT##	;RESET EOPTAB.
	POP	EACA,	(EACA)
	POP	EACA,	(EACA)

	MOVE	TA,CURDAT
	ADD	TA,DATLOC
CKDT.Z:	LDB	TB,DA.PWA##	;PIC WORD ALLOCATED?
	JUMPE	TB,[LDB	TB,DA.SUB##	;NO, WORDS 8 & 9 ALLOCATED?
		JUMPE	TB,CKDT.Y	;NO
		MOVEI	TB,SZ.DOC	;YES
		JRST	.+2]
	MOVEI	TB,SZ.MSK+SZ.DOC	;YES, SPACE FOR BOTH ITEMS
	LDB	TE,DA.KEY##	;NO. OF WORDS FOR KEYS?
	ADDI	TB,(TE)		;ADD THEM IN
CKDT.Y:	MOVE	TA,CURDAT
	ADDI	TA,SZ.DAT(TB)	;TOTAL LENGTH
CKDT.T:	MOVEM	TA,CURDAT
	ADD	TA,DATLOC##	;GET CURRENT LOCATION
	HRRZ	TA,TA
	HRRZ	TB,DATNXT##	;END
	CAMG	TA,TB		;ALL DONE?
	JRST	CKDT.0		;NO
;SCAN FILE TABLES FOR NON-COMP RELATIVE KEYS

	MOVE	CH,[XWD	AS.SMC##,1]	;TELL PHASE G TO PUT
	PUSHJ	PP,PUTASN			; OUT A FORM FEED
	MOVE	CH,[XWD	AS.PFF##,AS.MS1##]	; HERE.
	PUSHJ	PP,PUTASN
	SWOFF	FASUB+FBSUB	;JUST INCASE
	SETZM	RELKEY		;ONLY DO IT ONCE

	MOVE	TA,FILLOC##	;ARE THERE ANY FILE TABLES?
	CAMN	TA,FILNXT##
	POPJ	PP,		;NO, RETURN.

	MOVEI	TA,CD.FIL*1B20+1
CKFT.0:	PUSHJ	PP,LNKSET##
	MOVEM	TA,CURFIL##	;SAVE POINTER
	LDB	TB,FI.CKA##	;SEE IF NEEDED
	JUMPE	TB,CKFT.A	;NO
	PUSHJ	PP,GETTAG##	;GET NEXT TAG
	DPB	CH,FI.CKB##	;CONVERT BEFORE TAG
	PUSHJ	PP,PUTTAG##	;OUTPUT TAG TO ASYFIL
	LDB	TA,FI.CKB	;GET TAG
	PUSHJ	PP,REFTAG	;REFERENCE IT SO OPTIMIZER WILL LEAVE
	MOVE	TA,CURFIL
	LDB	TD,FI.CKA	;GET REAL KEY
	SETZ	TE,		;FAKE IT OUT
	MOVEI	TC,TE		; SINCE WE DON'T HAVE REAL OPERAND
	MOVEI	LN,EBASEA	;[752] SET IT UP AS "A" OPERAND
	PUSHJ	PP,SETOPN##	;[752] CANNOT USE SETOPA INCASE OF ERROR
	TSWF	FERROR		;[752] IF ERROR?
	JRST	CKFT.Z		;[752] GIVE UP
	MOVE	TE,[EBASEA,,EBASEB##]
	BLT	TE,EBASBX##	;COPY "A" TO "B"
	SETZM	EAC##		;USE AC'S 0 & 1
	SETZM	ECARRY##
IFN BIS,<
	SETOM	ESAFLG##	;DON'T MOVE FROM 10 TO 0
>
	PUSHJ	PP,MXAC.##	;GET IT INTO ACCS
IFN BIS,<
	SETZM	ESAFLG
>
	MOVE	CH,[MOVMM.##+ASINC,,AS.MSC]
	MOVE	TE,EAC
	DPB	TE,CHAC##	;INCASE BIS DP
	PUSHJ	PP,PUTASY##	;OUTPUT MOVMM 0,
	MOVEI	CH,AS.PAR##	;+ %PARAM+0
	PUSHJ	PP,PUTASN
	MOVSI	CH,POPJ.+AC17
	PUSHJ	PP,PUTASY	;END WITH POPJ 17,

	PUSHJ	PP,GETTAG	;GET AFTER TAG FOR SKIP RETURN
	EXCH	TA,CURFIL	;GET FILE BACK
	DPB	CH,FI.CKA	;STORE TAG
	PUSH	PP,CH		;SAVE TAG
	PUSHJ	PP,PUTTAG##	;OUTPUT TAG TO ASYFIL
	EXCH	TA,(PP)		;SAVE TA, GET TAG #
	PUSHJ	PP,REFTAG	;REFERENCE IT SO OPTIMIZER WILL LEAVE
	POP	PP,TA
	EXCH	TA,CURFIL	;GET "A" BACK
	MOVSI	CH,AOS.##+17	;AOS (17)
	PUSHJ	PP,PUTASY
	PUSHJ	PP,GETTAG	;GET AFTER TAG FOR NON-SKIP RETURN
	PUSH	PP,CH		;SAVE TAG
	PUSHJ	PP,PUTTAG##	;OUTPUT TAG TO ASYFIL
	EXCH	TA,(PP)		;SAVE TA, GET TAG #
	PUSHJ	PP,REFTAG	;REFERENCE IT SO OPTIMIZER WILL LEAVE
	POP	PP,TA
IFE BIS,<
	SETZM	EAC		;RESULT IS IN AC 0
	MOVE	CH,[MOVM.##+ASINC,,AS.MSC]
>
IFN BIS,<
	MOVEI	CH,5
	MOVEM	CH,EAC		;RESULT IS IN AC 5
	MOVE	CH,[MOVM.##+AC5+ASINC,,AS.MSC]
>
	PUSHJ	PP,PUTASY	;GET KEY BACK
	MOVEI	CH,AS.PAR
	PUSHJ	PP,PUTASN
	MOVEI	TE,D1MODE##	;
	MOVEM	TE,EMODEA	;HOWEVER "A" IS 1-WORD COMP
	MOVEI	TE,^D10		;MAX. SIZE OF 1 WORD
	CAMGE	TE,ESIZEA	;IS "B" LARGER THAN 1 WORD
	MOVEM	TE,ESIZEA	;YES, RESET IT
	PUSHJ	PP,MACX.##	;STORE BACK
	MOVSI	CH,POPJ.+AC17
	PUSHJ	PP,PUTASY	;POPJ 17,
	MOVE	TA,CURFIL
;CHECK FOR NON-LITERAL LINAGE COUNTER ITEMS

CKFT.A:	LDB	TD,FI.LCP##	;ANY LINAGE-COUNTER?
	JUMPE	TD,CKFT.Z	;NO
	LDB	CH,FI.LCI##	;YES, DO WE NEED TO CONVERT
	JUMPE	CH,CKFT.Z	;NO
	PUSHJ	PP,PUTTAG##	;OUTPUT TAG
	LDB	TD,FI.LCP	;GET LINAGE-COUNTER AGAIN
	SETZ	TE,		;FAKE IT OUT
	MOVEI	TC,TE		; SINCE WE DON'T HAVE REAL OPERAND
	PUSHJ	PP,SETOPB##	;SET IT UP AS "B" OPERAND
	MOVEI	TD,1
	MOVEM	TD,EINCRB##	;OFFSET FROM LINAGE-COUNTER
	HRRZ	TA,CURFIL
	LDB	TD,FI.LPP##	;GET LINES PER PAGE
	TRNN	TD,700000	;LITERAL?
	JRST	CKFT.B		;YES
	SETZ	TE,		;FAKE IT OUT
	MOVEI	TC,TE		; SINCE WE DON'T HAVE REAL OPERAND
	MOVEI	LN,EBASEA	;[752] SET IT UP AS "A" OPERAND
	PUSHJ	PP,SETOPN##	;[752] CANNOT USE SETOPA INCASE OF ERROR
	TSWF	FERROR		;[752] IF ERROR?
	JRST	CKFT.Z		;[752] GIVE UP
	SETZM	EAC##		;USE AC'S 0 & 1
	SETZM	ECARRY##
	PUSHJ	PP,MXAC.##	;GET IT INTO ACCS
	PUSHJ	PP,PUTASA##
	HRRZ	TA,CURFIL
	MOVSI	CH,HRLM.##
	PUSHJ	PP,PUT.B##
CKFT.B:	HRRZ	TA,CURFIL
	LDB	TD,FI.WFA##	;GET WITH FOOTING AT LIMIT
	TRNN	TD,700000	;LITERAL?
	JRST	CKFT.C		;YES
	SETZ	TE,		;FAKE IT OUT
	MOVEI	TC,TE		; SINCE WE DON'T HAVE REAL OPERAND
	MOVEI	LN,EBASEA	;[752] SET IT UP AS "A" OPERAND
	PUSHJ	PP,SETOPN##	;[752] CANNOT USE SETOPA INCASE OF ERROR
	TSWF	FERROR		;[752] IF ERROR?
	JRST	CKFT.Z		;[752] GIVE UP
	SETZM	EAC##		;USE AC'S 0 & 1
	SETZM	ECARRY##
	PUSHJ	PP,MXAC.##	;GET IT INTO ACCS
	PUSHJ	PP,PUTASA##
	MOVSI	CH,HRRM.##
	PUSHJ	PP,PUT.B##

CKFT.C:	HRRZ	TA,CURFIL
	AOS	EINCRB		;OFFSET IS NOW 2
	LDB	TD,FI.LAT##	;GET LINES AT TOP
	TRNN	TD,700000	;LITERAL?
	JRST	CKFT.D		;YES
	SETZ	TE,		;FAKE IT OUT
	MOVEI	TC,TE		; SINCE WE DON'T HAVE REAL OPERAND
	MOVEI	LN,EBASEA	;[752] SET IT UP AS "A" OPERAND
	PUSHJ	PP,SETOPN##	;[752] CANNOT USE SETOPA INCASE OF ERROR
	TSWF	FERROR		;[752] IF ERROR?
	JRST	CKFT.Z		;[752] GIVE UP
	SETZM	EAC##		;USE AC'S 0 & 1
	SETZM	ECARRY##
	PUSHJ	PP,MXAC.##	;GET IT INTO ACCS
	PUSHJ	PP,PUTASA##
	MOVSI	CH,HRLM.##
	PUSHJ	PP,PUT.B##

CKFT.D:	HRRZ	TA,CURFIL
	LDB	TD,FI.LAB##	;GET LINES AT BOTTOM
	TRNN	TD,700000	;LITERAL?
	JRST	CKFT.E		;YES
	SETZ	TE,		;FAKE IT OUT
	MOVEI	TC,TE		; SINCE WE DON'T HAVE REAL OPERAND
	MOVEI	LN,EBASEA	;[752] SET IT UP AS "A" OPERAND
	PUSHJ	PP,SETOPN##	;[752] CANNOT USE SETOPA INCASE OF ERROR
	TSWF	FERROR		;[752] IF ERROR?
	JRST	CKFT.Z		;[752] GIVE UP
	SETZM	EAC##		;USE AC'S 0 & 1
	SETZM	ECARRY##
	PUSHJ	PP,MXAC.##	;GET IT INTO ACCS
	PUSHJ	PP,PUTASA##
	MOVSI	CH,HRRM.##
	PUSHJ	PP,PUT.B##
CKFT.E:	HRRZ	TA,CURFIL
	MOVSI	CH,POPJ.+AC17	;YES
	PUSHJ	PP,PUTASY	;END WITH POPJ 17,

CKFT.Z:	LDB	TA,FI.NXT##	;GET NEXT
	JUMPN	TA,CKFT.0
	POPJ	PP,

>
;SET UP DUMMY ARG INDEX LOCS

DUMARG:	HRRZ	TC,EOPLOC	;MAKE PTR TO FIRST ARG
	ADDI	TC,3
	MOVEM	TC,CUREOP

;COUNT ARGS

	MOVEI	TB,1		;INIT ARG COUNT,
	MOVEM	TB,ARGCTR	;  PLUS 1 FOR CALLER'S ARG PTR LOC
	HRRZ	EACA,EOPNXT

DUM1:	AOS	ARGCTR		;BUMP CTR
	LDB	TB,[POINT 6,1(TC),17]	;SKIP OVER SUBSCRIPTS
	IMULI	TB,2		; [330] EACH SUBSCRIPT TAKES TWO WORDS.
	ADDI	TC,2(TB)
	CAIG	TC,(EACA)	;END OF LIST?
	JRST	DUM1		;NO

	MOVE	TA,[OCTLIT,,1]	;PUT ARG COUNT IN LIST
	PUSHJ	PP,STASHI
	MOVN	TA,ARGCTR
	HRLZI	TA,(TA)
	PUSHJ	PP,STASHL
	AOS	ELITPC

;PUT ADDRESSES OF DUMMY ARG INDEX LOCS IN LIST

	HRRZ	TA,ARGCTR	;SET UP XWD LIST IN LITTAB
	LSH	TA,1
	HRLI	TA,XWDLIT##
	PUSHJ	PP,STASHI

	MOVEI	TA,0		;OUTPUT CALLER'S ARG PTR ADDR
	PUSHJ	PP,STASHL
	HRLZ	TA,ARGPTR
	HRRI	TA,AS.MSC
	PUSHJ	PP,STASHL
	AOS	ELITPC

	SKIPA	TC,CUREOP	;RESET ARG PTR
DUM2:	MOVEM	TC,CUREOP
	HRRZ	TA,1(TC)	;GET DATAB LINK
	CAIL	TA,<CD.DAT>B20	;BE SURE IT IS A DATAB LINK
	CAILE	TA,<CD.DAT>B20+77777
	JRST	BADONE		;ERROR

	PUSHJ	PP,LNKSET	;GET ABS PTR
	MOVEM	TA,CURDAT##
	LDB	TB,DA.LKS##	;MAKE SURE IT IS IN LINKAGE SECTION
	JUMPE	TB,BADONE	;ERROR
	LDB	TB,DA.LVL	;MUST BE 01 OR 77 LEVEL
	CAIE	TB,77
	CAIN	TB,01
	TDZA	TA,TA		;PUT OUT LEFT HALF OF XWD
	JRST	BADONE		;?ILLEGAL DUMMY ARG
	PUSHJ	PP,STASHL
	AOS	ELITPC

	MOVE	TA,CURDAT	;GET BACK DATAB PTR
DUM5:	LDB	TB,DA.LVL##	;LEVEL 01 OR 77?
	CAIE	TB,01
	CAIN	TB,77
	JRST	DUM6		;YES
	LDB	TA,DA.BRO##	;NO, GET FATHER/BROTHER LINK
	PUSHJ	PP,LNKSET
	JRST	DUM5		;KEEP LOOKING FOR THE 01 ITEM

DUM6:	LDB	TB,DA.ARG##	;GET ASSIGNED INDEX LOC, IF ANY
	JUMPN	TB,DUM3		;OK
	MOVE	TB,EAS1PC	;HAVE TO ASSIGN ONE
	AOS	EAS1PC
	DPB	TB,DA.ARG
	PUSHJ	PP,PUTOC0	;OCTAL 0 TO AS1FIL

DUM3:	PUSH	PP,TB		;[***] SAVE INDEX LOC
DUM3A:	LDB	TA,DA.BRO	;[***] SEE IF IT HAS A BROTHER
	JUMPE	TA,DUM3B	;[***] NO, GIVE UP
	PUSHJ	PP,LNKSET	;[***] POINT TO IT
	LDB	TB,DA.RDF##	;[***] IS IT A REDEFINES
	JUMPE	TB,DUM3A	;[***] NO, TRY NEXT
	MOVE	TB,0(PP)	;[***] GET BACK INDEX LOC
	DPB	TB,DA.ARG	;[***] STORE SAME LOC FOR REDEFINED ITEM
	JRST	DUM3A		;[***] TRY NEXT

DUM3B:	POP	PP,TB		;[***] RESTORE INDEX LOC
	IORI	TB,AS.PAR	;MAKE IT A %PARAM LOC
	HRLZI	TA,(TB)
	HRRI	TA,AS.MSC
	PUSHJ	PP,STASHL

DUM4:	MOVE	TC,CUREOP	;UP TO NEXT ENTRY
	LDB	TB,[POINT 6,1(TC),17]
	IMULI	TB,2		; [330] EACH SUBSCRIPT TAKES TWO WORDS.
	ADDI	TC,2(TB)
	CAIG	TC,(EACA)
	JRST	DUM2

	POPJ	PP,

;BAD DUMMY ARG

BADONE:	MOVEI	DW,E.93		;?MUST BE IN LINKAGE SECTION
	PUSHJ	PP,OPNFAT
	MOVEI	TA,0		;PUT A 0 IN THE LIST
	PUSHJ	PP,STASHL
	JRST	DUM3		;GO ON WITH LIST

;PUT AN OCTAL 0 INTO AS1FIL

PUTOC0:	MOVE	CH,[AS.OCT,,1]
	PUSHJ	PP,PUTAS1
	MOVEI	CH,0
	JRST	PUTAS1
SUBTTL	GENERATE A "GOBACK" OR "EXIT PROGRAM"

GOBKGN:	HRLZI	CH,ASINC+SKIPL.##	;"SKIPL %CALLFLAG"
	HRRI	CH,AS.MSC
	PUSHJ	PP,PUTASY
	HRRZ	CH,RETPTR
	PUSHJ	PP,PUTASN

	TLNE	W1,(GOBAKF)	;GOBACK?
	JRST	GOBGN1		;YES, DO STOPR.

	PUSHJ	PP,GETTAG	;NO, "JRST %TAG"
	ANDI	CH,77777
	HRRZM	CH,ENTAGS
	IORI	CH,AS.TAG##
	HRLI	CH,JRST.
	HRRZ	TA,CH		;GET TAG NUMBER
	PUSHJ	PP,REFTAG##	;REFERENCE IT
	PUSHJ	PP,PUTASY
	JRST	GOBGN2

GOBGN1:	MOVEI	CH,STOPR.##	;"PUSHJ 17,STOPR."
	PUSHJ	PP,PUT.PJ

GOBGN2:	HRLZI	CH,ASINC+SETZM.##	;"SETZM %RETPTR"
	HRRI	CH,AS.MSC
	PUSHJ	PP,PUTASY
	HRRZ	CH,RETPTR
	PUSHJ	PP,PUTASN

	MOVE	CH,[ASINC+MOVEI.##+AC16,,AS.MSC]	;"RESF. %FILES"
	PUSHJ	PP,PUTASY
	MOVEI	CH,AS.FLS
	PUSHJ	PP,PUTASN
	MOVEI	CH,RESF%##
	PUSHJ	PP,PUT.PJ		;PUT IN ASY FILE


	SKIPE	PRODSW		;/P ON?
	JRST	GOBGN3		;YES, NO TRACE CODE

	MOVEI	CH,C.TRCE##
	PUSHJ	PP,PUT.PJ
	MOVE	CH,[AS.XWD,,1]
	PUSHJ	PP,PUTASN
	MOVEI	CH,10001	;GOBACK FLAG + ARG COUNT
	TLNN	W1,(GOBAKF)	;GOBACK OR EXIT PGM?
	ADDI	CH,10000	;EXIT PROG
	PUSHJ	PP,PUTASN
	MOVEI	CH,0
	PUSHJ	PP,PUTASY

GOBGN3:	HRLZI	CH,AC17+POPJ.##	;"POPJ 17,"
	PUSHJ	PP,PUTASY

	TLNE	W1,(GOBAKF)	;GOBACK?
	POPJ	PP,		;YES

	HRRZ	CH,ENTAGS		;"%TAG:" AFTER EXIT PROGRAM
	PJRST	PUTTAG
SUBTTL	GENERATE A "CANCEL"

CANGEN:	SWOFF	FEOFF1		;RESET FLAGS
	MOVEM	W1,OPLINE	;SAVE POSITION OF OPERATOR

CANGN1:	MOVE	EACA,EOPNXT
	CAMN	EACA,EOPLOC	;MORE OPERANDS?
	POPJ	PP,		;NO, THATS ALL

	HRRZ	TC,EOPLOC	;GET NEXT OPERAND
	MOVEI	TC,1(TC)
	MOVEM	TC,CUREOP
	MOVE	CH,1(TC)	;GET EXTAB INDEX
IFN ANS74,<
	LDB	TB,[POINT 3,CH,20]
	CAIN	TB,CD.DAT	;SEE IF JUST DATAB LINK
	JRST	CANGN5		;YES IT IS
>
	ANDI	CH,77777	;CLEAR REST
	IORI	CH,AS.EXT	;EXTERNAL
	TLO	CH,MOVEI.+AC16	
	PUSHJ	PP,PUTASY

	HRRZI	CH,CANCL.##	;GET EXTAB LINK TO CANCEL
	PUSHJ	PP,PUT.PJ	;<PUSHJ 17,CANCL.>

	MOVE	TA,1(TC)	;GET EXTAB ADDR
	PUSHJ	PP,LNKSET
	LDB	TB,EX.ENT##	;CHECK FOR LEGAL CANCEL
	MOVEI	DW,E.565	;MESSAGE NUMBER
	JUMPN	TB,OPNFAT	;CANNOT CANCEL INTERNAL ENTRY POINT

	SETO	TE,		;SET "REFD IN NON-RES"
	TSWF	FAS3		;CK NON-RES FLAG
	DPB	TE,EX.NRS


CANGN4:	MOVE	TA,[2,,2]	;GO TO NEXT OPERAND
	ADDM	TA,EOPLOC
	JRST	CANGN1
;HERE FOR ANS-74 CALL WITH SUBROUTINE UNKNOWN AT COMPILE TIME

IFN ANS74,<
CANGN5:	MOVE	TA,CH
	PUSHJ	PP,LNKSET
	MOVE	TC,CUREOP	;POINT TO IT
	PUSHJ	PP,SETOPA	;GET ARG
	MOVE	TE,[EBASEA,,EBASEB]
	BLT	TE,EBASBX	;COPY 
	MOVEI	TE,D6MODE##	;FORCE SIXBIT
	MOVEM	TE,EMODEB	;AS TARGET
	MOVEI	TE,6		;6 OR LESS CHARS.
	MOVEM	TE,ESIZEB##	;LEFT JUSTIFIED
	MOVEI	TE,1		;GET 1 WORD
	PUSHJ	PP,GETEMP	; OF TEMP STORAGE
	MOVEM	EACC,EINCRB	;POINT "B" AT TEMP
	MOVE	TA,[^D36,,AS.MSC]
	MOVEM	TA,EBASEB
	SWOFF	FBSUB
	PUSHJ	PP,MXX.##	;GO DO MOVE
	MOVSI	CH,MOV##+AC16
	PUSHJ	PP,PUT.B	;MOVE 16,%TEMP+N
	MOVEI	CH,CANCL.
	PUSHJ	PP,PUT.PJ	;PUSHJ 17,CANCL.
	JRST	CANGN4		;FINISH OFF
>

	END