Google
 

Trailing-Edge - PDP-10 Archives - ap-c800d-sb - mesgen.mac
There are 7 other files named mesgen.mac in the archive. Click here to see a list.
; UPD ID= 1959 on 6/25/79 at 12:30 AM by N:<NIXON>
TITLE	MESGEN FOR COBOL V12
SUBTTL	GENERATORS FOR MCS & TCS VERBS	SUMNER BLOUNT/CAM



;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	P
	%%P==:%%P
	MCS==:MCS
	TCS==:TCS

;EDITS
;V10*****************
;NAME	DATE		COMMENTS
;DAW	12-OCT-78	;[576] FIX "?BAD LITAB CODE" - IN "ENABLE" STMT CODE GEN.
;	14-APR-76	; [425] FIX UNSTRING/STRING AND MCS VERBS TO WORK IN NON-RESIDENT SECTIONS
;	19-FEB-76	FIX SEND WITH DATA-NAME FOR MCS.
;********************

TWOSEG
SALL
RELOC	400000



IFN MCS!TCS,<
ENTRY	RCVGEN, DISGEN, ACTGEN, SNDGEN
	>

;MCSGEN CONTAINS SOME ROUTINES THAT ARE USED BY OTHER MODULES (STRGEN)

ENTRY	WRDGEN,SETUP,SIX40,CSEQGN,PTRGEN
ENTRY	OUTVAL,SWAP,FIXLIT,GETTAB,XWDGEN,D1GEN


	EXTERN		STASHI,STASHL,STASHP,STASHQ,POOLIT
	EXTERNAL	EBASEB, M.ARG1, M.ARG2, M.ARG3, M.ARG4, M.ARG5
	EXTERNAL	M.ARGP, M.SIXL, M.STR, FNDPOP, LITNN, MCSCTR
	EXTERNAL	M.AFLG, TB.VAL, TB.DAT, EMODEA, D1MODE, FATAL
	EXTERNAL	DSMODE
IFN MCS!TCS,<	EXTERNAL	CDLOC>



;A COUPLE OF MACROS...

DEFINE	IFNTAB(TABCOD,LOC),<
	PUSHJ	PP,GETTAB
	CAIE	TB,TABCOD
	JRST	LOC
	>

DEFINE	IFTAB(TABCOD,LOC),<
	PUSHJ	PP,GETTAB
	CAIN	TB,TABCOD
	JRST	LOC
	>

;GENERATOR FOR "RECEIVE" VERB.

IFN MCS!TCS,<

RCVGEN:	SETZM	M.SIXL##	;CLR SIXBIT LITERAL FLAG FOR PTRGEN
	SETZM	M.STR##		;NO SPECIAL STRING/UNSTRING ITEMS HERE
IFN TCS,<
	MOVEI	TB,1		;MIGHT BE MISSING INTO DATA-NAME
	CAMN	TB,EACC		;IF TCS SYNTAX
	JRST	RCVTC		;YES
>
	MOVEI	TB,2		;CHECK # OF ARGS
	PUSHJ	PP,SETUP
	PUSHJ	PP,PTRGEN	;GENERATE CD-ENTRY ARG
	MOVE	TB,M.ARGP	;GET CURRENT ARG
	MOVEM	TB,M.ARG1##	;SAVE IT
	MOVE	TB,EBASEA	;SAVE LINK TO CD-RECORD
	MOVEM	TB,EBASEB##
	HRRZ	TC,CUREOP	;CK RECEIVING ITEM'S ANCESTRY
	HRRZ	TB,1(TC)
RCVG1:	PUSHJ	PP,FNDPOP##	;HAS IT GOT A FATHER?
	JRST	RCVG2		;NO, THATS GOOD
	LDB	TA,[POINT 3,TB,20]	;FATHER IN DATAB?
	CAIE	TA,CD.DAT
	JRST	RCVG2		;NO
	CAMN	TB,EBASEB	;IF SO, BETTER NOT BE CD-RECORD
	JRST	[HRRZI DW,E.466	;?REC-ITEM IN CD-RECORD
		 JRST OPNFAT##]
	JRST	RCVG1		;CK GRANDFATHER
RCVG2:	PUSHJ	PP,PTRGEN	;OUTPUT 2ND ARG
	MOVE	TB,M.ARGP
	MOVEM	TB,M.ARG2##	;AND SAVE IT FOR LATER
	HRLZI	TB,-2
	PUSHJ	PP,WRDGEN	;GENERATE # OF LITAB ARGS TO FOLLOW
	MOVE	TA,ELITPC
	MOVEM	TA,LITNN##	;SAVE ADDRESS OF 1ST ARG
	MOVE	TA,M.ARG1
	MOVEM	TA,M.ARGP
	PUSHJ	PP,SIX40	;OUTPUT "XWD 640,<ARG-PTR>"
	MOVE	TA,M.ARG2
	MOVEM	TA,M.ARGP	;SET UP 2ND ARG
	PUSHJ	PP,SIX40	;SAME AS ABOVE
RCVG3:	SETZB	TA,TB		;INITIALIZE COUNTER FOR RCVTAB
	LDB	TB,[POINT 1,W1,9]	;GET SEGMENT FLAG
	SKIPE	TB
	ADDI	TA,2		;BUMP CTR IF SET
	LDB	TB,[POINT 1,W1,10]	;GET NO-DATA FLAG
	SKIPE	TB
	ADDI	TA,1		;BUMP CTR IF SET
	XCT	RCVTAB(TA)	;GET CORRECT ROUTINE NAME
	JRST	CSEQGN		;OUTPUT "MOVEI	16,LITNN
				;	PUSHJ	PP,ROUTINE"
IFN TCS,<
RCVTC:	PUSHJ	PP,SETUP
	PUSHJ	PP,PTRGEN	;GENERATE CD-ENTRY ARG
	MOVE	TB,M.ARGP	;GET CURRENT ARG
	MOVEM	TB,M.ARG1##	;SAVE IT
	MOVE	TB,EBASEA	;SAVE LINK TO CD-RECORD
	SETZM	M.ARG2		;JUST IN CASE
	HRLZI	TB,-1		;ONLY 1 ARG
	PUSHJ	PP,WRDGEN	;GENERATE # OF LITAB ARGS TO FOLLOW
	MOVE	TA,ELITPC
	MOVEM	TA,LITNN##	;SAVE ADDRESS OF 1ST ARG
	MOVE	TA,M.ARG1
	MOVEM	TA,M.ARGP
	PUSHJ	PP,SIX40	;OUTPUT "XWD 640,<ARG-PTR>"
	JRST	RCVG3
>


;TABLE OF "PUSHJ'S" WHICH IS ACCESSED ACCORDING TO WHETHER
;THE SEGMENT AND NO-DATA FLAGS ARE SET.

RCVTAB:	HRRZI	TA,M.RMW##	;MSG,WAIT
	HRRZI	TA,M.RMNW##	;   ,NO-W
	HRRZI	TA,M.RSW##	;SEG,WAIT
	HRRZI	TA,M.RSNW##	;   ,NO-W

	>
SUBTTL	SUBROUTINES

;PERFORM NORMAL SET-UP

SETUP:	CAMLE	TB,EACC		;TOO FEW ARGS?
	JRST	BADEOP##	;YES, ABORT
	HRRZ	TA,EOPLOC##
	ADDI	TA,1
	MOVEM	TA,CUREOP##
	POPJ	PP,

;OUTPUT A SINGLE WORD IN TB (CHOOSE DECIMAL OR OCTAL)

D1GEN:	SKIPA	TA,[XWD D1LIT##,1]	;DECIMAL ENTRY
WRDGEN:	MOVE	TA,[XWD OCTLIT##,1]	;OCTAL ENTRY
	PUSHJ	PP,STASHI
	MOVE	TA,TB		;OUTPUT WORD
	PUSHJ	PP,STASHL
	AOS	ELITPC
	POPJ	PP,

;OUTPUT		XWD	640,<M.ARGP>

SIX40:	MOVEI	TB,640		;DEFAULT IS 640
SIX40A:	MOVE	TA,M.ARGP##	;GET RH=<ARGPTR>
	MOVEM	TA,XWDRH##	;THEN FALL INTO XWDGEN

;OUTPUT A SINGLE XWD
;ENTER WITH LH IN TB, RH IN XWDRH

XWDGEN:	MOVE	TA,[XWD XWDLIT##,2]
	PUSHJ	PP,STASHI
	MOVE	TA,TB		;LEFT HALF
	PUSHJ	PP,STASHL
	MOVE	TA,XWDRH##	;RIGHT HALF
	PUSHJ	PP,STASHL##
	AOS	ELITPC
	POPJ	PP,


;ENTER WITH TA=<ROUTINE>
;GENERATES	MOVEI	16,<LITNN>
;		PUSHJ	17,<ROUTINE>

CSEQGN:	MOVSI	CH,MOVEI.##
	TLO	CH,AC16		;SET AC=16
	HRRI	CH,AS.MSC##
	TLO	CH,ASINC
	PUSHJ	PP,PUTASY##	;OUTPUT IT
	HRRZ	CH,LITNN##	;GET ADDRESS OF ARGS
	IORI	CH,AS.LIT##
	PUSHJ	PP,PUTASN##
	MOVE	CH,TA
	JRST	GNPSX.##	; [425] COMPLETE "PUSHJ 17," AND TAKE CARE IF IN NON-RESIDENT SECTION.
SUBTTL	GENERATE ONE ARGUMENT FOR MCS
;
;
;THIS ROUTINE GENERATES ONE ARGUMENT IN THE LITERAL TABLE
;IN THE FOLLOWING FORM:
;
;IF DISPLAY:     POINT A,<ITEM>,B
;		 XWD 0,SIZE
;
;IF ASCII LITERAL:	%%A: ASCII /TEXT/
;			     POINT 7,%%A
;			     XWD 0,SIZE
;
;CUREOP IS BUMPED BY ONE ARGUMENT UPON EXIT, AND ALL SUBSCRIPTING
;IS TAKEN CARE OF AUTOMATICALLY.  UPON EXIT, M.ARGP CONTAINS A
;POINTER TO THE ARGUMENT IN LITAB FORMAT.
;
;
;
;

PTRGEN:	HRRZ	TC,CUREOP
	SETZB	TB,TD
	HRRZ	TB,1(TC)	;GET TABLE LINK
	LDB	TD,[POINT 3,TB,20]
	JUMPE	TD,ARG.0	;ZERO TABLE CODE? YES, ITS A CD-ENTRY
	CAIN	TD,TB.DAT##	;DATAB?
	JRST	ARG.0A		;YES
	CAIN	TD,TB.VAL##	;VALTAB?
	JRST	ARG.0A
	TTCALL	3,[ASCIZ /?INVALID DATA-TYPE--PTRGEN
/]
	POPJ	PP,

ARG.0:
IFE MCS!TCS,<
	TTCALL	3,[ASCIZ /?INVALID CD-ENTRY AT PTRGEN
/]
	>
IFN MCS!TCS,<
	ADD	TB,CDLOC##
	HLRZ	TA,2(TB)	;GET CD-RECORD DATAB LINK
	HRRM	TA,1(TC)	;STASH IT IN EOPTAB!!
	>
ARG.0A:	PUSHJ	PP,SETOPA##	;PARSE A OPERAND
	TSWF	FERROR		;ANY BOO-BOOS
	JRST	ENDTST		;YES, FLUSH OPERAND
ARG.2:	TSWT	FASUB		;SUBSCRIPTED?
	JRST	NOSUB		;NO
	HRLZ	TA,CUREOP	;YES
	HLRS	TA		;SET UP "OPERND"
	ADDI	TA,2
	MOVEM	TA,OPERND##
	PUSHJ	PP,SUBSCA##	;DO SUBSCRIPT
	TSWT	FASUB		;IF FLAG STILL ON, THERE WERE NON-LIT SUBSC.
	JRST	ARG.3		;LITERAL SUBS
	SKIPE	M.STR		;THIS A SPECIAL STRING/UNSTR ITEM?
	JRST	STRSUB		;YES
	MOVE	TA,EAS1PC##	;SAVE PARAM PC FOR A SEC
	MOVEM	TA,M.ARGP
	MOVE	CH,[XWD AS.OCT##,1]
	PUSHJ	PP,PUTAS1##	;OUTPUT  EXP 0
	SETZ	CH,
	PUSHJ	PP,PUTAS1
	AOS	EAS1PC
	MOVE	TB,EMODEA	;IS IT  COMP?
	CAILE	TB,DSMODE
	JRST	ARG.2A		;YES
	MOVE	CH,[XWD AS.OCT,1]	;OUTPUT XWD 0,SIZE
	PUSHJ	PP,PUTAS1
	HRRZ	CH,ESIZEA
	PUSHJ	PP,PUTAS1
	AOS	EAS1PC
ARG.2A:	MOVSI	CH,MOVEM.##	;OUTPUT "MOVEM 12,%PARAM+N"
	TLO	CH,AC16-AC4	;OR, AC12 (GET IT?)
	HRRI	CH,AS.MSC
	TLO	CH,ASINC
	PUSHJ	PP,PUTASY
	HRRZ	CH,M.ARGP
	IORI	CH,AS.PAR##	;THIS GOES IN PARAMS
	PUSHJ	PP,PUTASN	;[155]
	HRLZ	TA,M.ARGP
	TLO	TA,AS.PAR##	;SET UP ARGPTR FOR %PARAM AREA
	HRRI	TA,AS.MSC
	MOVEM	TA,M.ARGP
	JRST	ENDTST

STRSUB:	HRLZ	TA,M.STR	;MAKE PTR FOR ARG LIST
	TLO	TA,AS.LIT
	HRRI	TA,AS.MSC
	MOVEM	TA,M.ARGP
	HRRZ	TB,ESIZEA	;"XWD 0,SIZE" FOLLOWS SUBSCR-BLK
	TSWF	FANUM		;SET SIGN BIT IF NUMERIC
	TLO	TB,(1B0)
	MOVEM	TB,XWDRH
	SETZ	TB,
	PUSHJ	PP,XWDGEN
	JRST	ENDTST

NOSUB:	MOVE	TA,EMODEA##	;CHECK FOR LITERAL
	CAIE	TA,LTMODE##
	JRST	ARG.3		;REGULAR DATA-TYE
	HRLZI	TA,ASCLIT##	;BEGIN AS IF ASCII
	SKIPE	M.SIXL		;DOES CALLER WANT SIXBIT?
	HRLZI	TA,SIXLIT##	;YES
	MOVE	TC,ESIZEA##	;COMPUTE WORD-LENGTH OF LITERAL
	MOVEI	TD,5		;5 ASCII CHARS/WORD
	SKIPE	M.SIXL		;SIXBIT WANTED?
	MOVEI	TD,6		;YES
	IDIVI	TC,(TD)
	SKIPE	TB		;REMAINDER?
	AOS	TC		;YES, BUMP WORD-COUNT
	HRRZM	TC,M.ARGP	;(SAVE WORD-LENGTH TEMPORARILY)
	HRR	TA,TC
	PUSHJ	PP,STASHI	;[576] PUT OUT HEADER
	HRRZ	TD,ESIZEA
	MOVEI	TA,D7MODE##	;ASSUME ASCII
	SKIPE	M.SIXL		;SIXBIT WANTED?
	MOVEI	TA,D6MODE##	;YES
	MOVEM	TA,EMODEB##
	SETZM	IMCONS##	;INCASE STILL ON
	PUSHJ	PP,VALLIT##	;MOVE LITERAL TO LITAB
	TLNN	TB,1B18		;ANYTHING LEFT?
	PUSHJ	PP,STASHL	;OUTPUT LAST WORD
	MOVE	TB,ELITPC	;SAVE ITS ADDRESS
	MOVE	TA,M.ARGP	;GET LENGTH BACK
	ADD	TA,ELITPC
	MOVEM	TA,ELITPC	;BUMP ELITPC BY LENGTH IN WORDS
	MOVE	TA,[XWD BYTLIT##,2]
	PUSHJ	PP,STASHI
	MOVEI	TA,AS.MSC##
	PUSHJ	PP,STASHL
	HRLZI	TA,440700	;SET UP BYTE PTR FOR ASCII
	SKIPE	M.SIXL		;SIXBIT WANTED?
	HRLZI	TA,440600	;YES
	ADD	TA,TB		;AND LITAB OFFSET
	TRO	TA,AS.LIT##
	PUSHJ	PP,STASHL
	JRST	ARG.4

ARG.3:	MOVE	TB,EMODEA	;IS IT COMP?
	CAILE	TB,DSMODE
	JRST	ARG.3C		;YES
	MOVE	TA,[XWD BYTLIT##,2]
	PUSHJ	PP,STASHI
	PUSHJ	PP,MBYTEA##	;OUTPUT BYTE PTR TO A
ARG.4:	HRLZ	TA,ELITPC##
	TLO	TA,AS.LIT##	;SET UP ARG PTR
	HRRI	TA,AS.MSC##
	MOVEM	TA,M.ARGP	;UPDATE ARGPTR
	AOS	ELITPC
	MOVE	TA,[XWD XWDLIT,2]	;SET UP FOR SIZE
	PUSHJ	PP,STASHI
	SETZ	TA,
	PUSHJ	PP,STASHL	;OUTPUT XWD 0,,
	MOVE	TA,ESIZEA##	;NO, GET SIZE OF ITEM
	SKIPN	M.STR		;A SPECIAL STRING/UNSTRING ITEM?
	JRST	ARG.4A		;NO
	TSWF	FANUM		;YES, SET SIGN BIT OF SIZE WORD IF NUMERIC
	TLO	TA,(1B0)
ARG.4A:	PUSHJ	PP,STASHL
	AOS	ELITPC
	JRST	ENDTST

ARG.3C:	MOVE	TB,EBASEA##	;GET DATAB LINK
	HRL	TB,EINCRA##	;PLUS INCREMENT IF ANY
	MOVEM	TB,M.ARGP

ENDTST:	PUSHJ	PP,BMPEOP##	;GET NEXT OPERAND
	  POPJ	PP,		;NO MORE OPERANDS
	POPJ	PP,		;GOOD EXIT!!!!
SUBTTL	DISABLE/ENABLE GENERATOR FOR MCS

IFN MCS!TCS,<

DISGEN:	SETZM	M.SIXL		;LITERAL PASSWORD ALWAYS ASCII
	SETZM	M.STR##		;NO SPECIAL STRING/UNSTRING ITEMS HERE
	MOVEI	TB,2
	PUSHJ	PP,SETUP
	PUSHJ	PP,PTRGEN	;OUTPUT 1ST ARG
	MOVE	TA,M.ARGP	;GET ARGPTR
	MOVEM	TA,M.ARG1	;AND SAVE IT
	PUSHJ	PP,PTRGEN
	MOVE	TA,M.ARGP
	MOVEM	TA,M.ARG2
	HRLZI	TB,-2		;PUT OUT HEADER WORD
	PUSHJ	PP,WRDGEN
	MOVE	TA,ELITPC
	MOVEM	TA,LITNN##	;SAVE ADDR OF ARGS
	MOVE	TA,M.ARG1
	MOVEM	TA,M.ARGP	;RESET 1ST ARG
	PUSHJ	PP,SIX40
	MOVE	TA,M.ARG2	;GET 2ND ARG
	MOVEM	TA,M.ARGP	;AND MAKE IT CURRENT ARG
	PUSHJ	PP,SIX40
	SETZB	TA,TB
	LDB	TB,[POINT 3,W1,11]	;GET BIT 9
	TRNE	TB,1B33			;ENABLE FLAG SET?
	ADDI	TA,3			;YES
	TRNE	TB,1B34			;HOW ABOUT TERMINAL FLAG?
	AOS	TA
	TRNE	TB,1B35		;..OR OUTPUT FLAG?
	ADDI	TA,2
	XCT	DISTAB(TA)
	JRST	CSEQGN		;..AND PUT THE WHOLE THING OUT!



;TABLE OF DISABLE/ENABLE ROUTINE ADDRESS

DISTAB:	MOVEI	TA,M.DI##
	MOVEI	TA,M.DIT##
	MOVEI	TA,M.DO##
ENTAB:	MOVEI	TA,M.EI##
	MOVEI	TA,M.EIT##
	MOVEI	TA,M.EO##

	>
SUBTTL	ACCEPT COUNT GENERATOR FOR MCS

IFN MCS!TCS,<

ACTGEN:	SETZM	M.SIXL		;CLR FOR PTRGEN
	SETZM	M.STR##		;NO SPECIAL STRING/UNSTRING ITEMS HERE
	MOVEI	TB,1
	PUSHJ	PP,SETUP
	PUSHJ	PP,PTRGEN	;SET UP AND PUT OUT AN ARG
	HRLZI	TB,-1
	PUSHJ	PP,WRDGEN	;COUNT=-1
	MOVE	TA,ELITPC
	MOVEM	TA,LITNN
	PUSHJ	PP,SIX40	;PUT OUT HEADER
	SETZB	TA,TB
	LDB	TB,[POINT 1,W1,9]
	SKIPN	TB
	SKIPA	TA,[XWD 0,M.AC##]	;GET ROUTINE ADDRESS
	HRRZI	TA,M.IFM##	;OR, THE OTHER ONE
	JRST	CSEQGN		;AND OUT WE GO...

	>
SUBTTL	SEND GENERATOR FOR MCS

IFN MCS!TCS,<

;THIS SECTION GENERATES THE CODE FOR THE SEND VERB.


;
;FOR EACH ARG IN THE SEND VERB, THERE IS A 2-BIT FLAG IN "M.AFLG"
;WHICH INDICATES WHAT VALUE SHOULD GO INTO THE LEFT HALF OF THE
;ARGUMENT XWD (E.G., 0,100,440, OR 640). THE VALUES OF THESE TWO
;BITS ARE, RESPECTIVELY: 0,1,2,3 (AS ONE WOULD EXPECT).
;SINCE THERE ARE 5 ARGS IN THE "SEND" CALL, BITS 26-35 ARE USED,
;WITH BITS 34-35 FOR ARG1,...,BITS 26,27 FOR ARG5.
;	(NOTE: BITS 26-27 ARE ALWAYS 0 BECAUSE ARG5 IS ALWAYS XWD 0,-
;
;
;
;START OF ARG1 PROCESSING
SNDGEN:	MOVEM	EACC,MCSCTR##	;SAVE # OF OPERANDS
	SETZM	M.ARG4		;INCASE NO ARG4
	SETZM	M.SIXL		;CLR FOR PTRGEN
	SETZM	M.STR##		;NO SPECIAL STRING/UNSTRING ITEMS HERE
	MOVEI	TB,3		;AT LEAST 3 ARGS
	PUSHJ	PP,SETUP
	CLEARM	M.AFLG##	;CLEAR ALL ARG-FLAGS
	PUSHJ	PP,PTRGEN	;OUTPUT CD-ENTRY
	MOVE	TA,M.ARGP
	MOVEM	TA,M.ARG1	;SAVE ITS ADDRESS
	MOVEI	TA,3B35		;ARG1 NEEDS AN "XWD 640,-"
	ORM	TA,M.AFLG	;SO, SET THE FLAG BITS

;START OF ARG2 PROCESSING
	IFNTAB	TB.VAL##,SEND2	;JUMP IF NOT VALTAB ENTRY
	CLEARM	M.ARG2##	;CLEAR ARG-PTR 
	PUSHJ	PP,BMPEOP	;AND GET NEXT ENTRY
	  JRST	OPERR
	JRST	SEND3

SEND2:	PUSHJ	PP,PTRGEN	;OUTPUT SENDING ITEM
	MOVE	TA,M.ARGP
	MOVEM	TA,M.ARG2	;SAVE ADDRESS
	MOVEI	TA,3B33		;CODE = 640
	ORM	TA,M.AFLG

;START OF ARG3 PROCESSING
SEND3:	IFNTAB	TB.VAL,SEND4	;JUMP IF NOT VALTAB
	PUSHJ	PP,OUTVAL	;OUTPUT VALTAB VALUE
	MOVEM	TB,M.ARG3##	;SAVE PTR
	MOVEI	TB,1B31		;CODE=100
	JRST	SEND5A

SEND4:	IFNTAB	TB.DAT##,TABERR	;ERROR IF NOT DATAB
	HRRZ	TC,CUREOP
	PUSHJ	PP,PTRGEN
	TSWF	FERROR		;ANY ERRORS?
	POPJ	PP,		;YES, EXIT
	MOVE	TB,M.ARGP
	MOVEM	TB,M.ARG3
	HRRZ	TB,EMODEA##
	CAILE	TB,DSMODE##	;DISP-6 OR -7?
	JRST	SEND5		;NO, COMP
	MOVEI	TB,3B31		;CODE = 640
	JRST	SEND5A		; [410] GO ON

SEND5:	HRRZ	TB,EMODEA
	CAIN	TB,D1MODE##	;1-WORD COMP?
	SKIPA	TB,[EXP 1B31]	;YES, SET CODE
	MOVEI	TB,2B31
SEND5A:	ORM	TB,M.AFLG
;START OF ARG4 PROCESSING
SEND6:	PUSHJ	PP,BMPEOP	;GET NEXT OPERAND
	  JRST	ARG5		;NO ARG4
	HRRZ	TC,CUREOP
	IFNTAB	TB.VAL##,SEND8	;JUMP IF NOT VALTAB
	TLNN	W1,1B28		;YES, IS IT "PAGE"?
	JRST	NOPAGE		;NO
	MOVEI	TB,1		;YES, SET UP "XWD 1,0"
	SETZM	XWDRH
	PUSHJ	PP,XWDGEN
	MOVE	TB,ELITPC
	SOS	TB		;BUMP PTR BACK TO ENTRY
	PUSHJ	PP,SWAP		;MAKE IT INTO A LITAB PTR
	MOVEM	TB,M.ARG4##
	SETZ	TB,		;CODE=000
	JRST	SEND11

NOPAGE:	PUSHJ	PP,OUTVAL	;OUTPUT INTEGER (OR ZERO)
FGZERO:	MOVEM	TB,M.ARG4
	MOVEI	TB,1B29
	JRST	SEND11

SEND8:	IFTAB	TB.DAT##,SEND9	;JUMP IF DATAB ENTRY
	MOVE	TB,0(TA)	;TEST FOR FIGCN ZERO
	TLC	TB,GWLIT!GNFCZ
	TLCN	TB,GWLIT!GNFCZ
	JRST	[SETZB	TB,TC		;YES, SET VALUE TO ZERO
		PUSHJ	PP,OUTV2	;OUTPUT IT AS IF LITERAL
		JRST	FGZERO]		;AND CONTINUE
	IFNTAB	TB.MNE##,TABERR
	MOVE	TB,1(TA)
	TRZ	TB,7B20		;CHOP OFF TABLE CODE
	ADD	TB,MNELOC##
	MOVE	TB,1(TB)	;GET WORD 2 OF ENTRY
	TLNE	TB,1B22		;CHANNEL NUMBER?
	JRST	SEND81		;YES
	LDB	LN,[POINT 13,W2,28]
	LDB	CP,[POINT 7,W2,35]
	MOVEI	DW,E.463	;BAD MNEMONIC ERROR
	JRST	FATAL##
SEND81:	SETZM	XWDRH		;PUT CHANNEL NUMBER IN LH
	PUSHJ	PP,XWDGEN	;PUT IT OUT
	MOVE	TB,ELITPC
	SOS	TB
	PUSHJ	PP,SWAP
	MOVEM	TB,M.ARG4
	JRST	ARG5

SEND9:	PUSHJ	PP,PTRGEN	;OUTPUT IT
	MOVE	TB,M.ARGP
	MOVEM	TB,M.ARG4
	HRRZ	TB,EMODEA
	CAILE	TB,DSMODE	;CHECK FOR DISPLAY
	JRST	SEND10		;ITS A COMP
	MOVEI	TB,3B29		;CODE=640
	JRST	SEND11

SEND10:	HRRZ	TB,EMODEA
	CAIN	TB,D1MODE	;1-WORD COMP?
	SKIPA	TB,[EXP 1B29]	;YES,SET CODE=100
	MOVEI	TB,2B29		;NO, SET CODE=440
SEND11:	ORM	TB,M.AFLG



;START OF ARG5 PROCESSING
ARG5:	LDB	TB,[POINT 1,W1,9]	;GET "AFTER" BIT
	PUSHJ	PP,OUTV2		;PUT IT OUT AS VALUE
	MOVEM	TB,M.ARG5##		;SAVE ITS ADDRESS TOO



;NOW, WE MUST OUTPUT THE ACTUAL ARGUMENT LIST:
;
;	XWD	-5,0
;	<ARG1>
;	<ARG2>
;	<ARG3>
;	<ARG4>
;	<ARG5>
;
;WE GET THE LEFT HALF OF EACH WORD FROM THE CODES WE STORED
;AND THE RIGHT HALF IS A PTR (M.ARG#) TO THE ACTUAL VALUE.
;
;
SEND.B:	HRLZI	TB,-5
	PUSHJ	PP,WRDGEN	;OUTPUT COUNT
	MOVE	TB,ELITPC
	MOVEM	TB,LITNN	;SAVE STARTING ADDRESS
	MOVEI	TC,1		;SET UP COUNTER
	MOVEI	TD,M.ARG1	;SET PTR TO 1ST ARG-PTR
;START OF LOOP:
LOOP:	SKIPE	(TD)		;ANY PTR THERE? (IF NOT, MUST BE ARG2 OR ARG4)
	JRST	NOTEMP
	SETZ	TB,
	PUSHJ	PP,WRDGEN	;YES, OUTPUT ZERO WORD
	JRST	ENLOOP
NOTEMP:	MOVE	TA,(TD)		;GET ARG-PTR
	MOVEM	TA,M.ARGP	;MAKE IT CURRENT
	LDB	TB,[POINT 2,M.AFLG,35
		POINT 2,M.AFLG,33
		POINT 2,M.AFLG,31
		POINT 2,M.AFLG,29
		POINT 2,M.AFLG,27]-1(TC)
;THAT LAST INSTRUCTION LOADS THE CORRECT FLAG BITS FROM THE FLAG WORD.

	MOVE	TB,.+2(TB)	;NOW, GET ACTUAL XWD CODE
	JRST	.+5
	EXP	0
	EXP	100
	EXP	440
	EXP	640

	SKIPE	TB		;IF LEFT HALF IS 0..
	CAIN	TB,640		;OR, 640, THEN GO ON
	JRST	NOIND
	HLRZS	TA		;LEFT HALF TO RIGHT HALF
	TRZ	TA,77777	;ISOLATE BITS 0-2
	CAIN	TA,AS.PAR	;IN %PARAMS AREA?
	TRO	TB,20		;YES, WE MUST SET INDIRECT BIT
NOIND:	PUSHJ	PP,SIX40A	;OUTPUT IT

ENLOOP:	AOS	TD		;BUMP PTR
	AOS	TC
	CAIE	TC,6		;END OF LOOP?
	JRST	LOOP
	MOVEI	TA,M.SEND##	;YES, OUTPUT "MOVEI 16,..."
	JRST	CSEQGN
OPERR:	MOVE	TA,MCSCTR
	CAIN	TA,3
	JRST	ARG5
	TTCALL	3,[ASCIZ /?FATAL--OPERAND ERROR--MCSGEN
/]
	JRST	BADEOP

TABERR:	TTCALL	3,[ASCIZ /?INVALID TABLE CODE--MESGEN
/]
	POPJ	PP,		;CATCH-ALL ERROR

;END OF SEND GENERATOR

	>
SUBTTL	MISC SUBROUTINES

;ROUTINE TO OUTPUT IN LITAB A LITERAL VALUE
;ENTER:	CUREOP POINTS TO CURRENT OPERAND IN LITERAL TABLE
;
;EXIT:		VALUE IN THE FORM "EXP <N>" HAS BEEN PUT IN LITERAL TABLE.
;AND TB CONTAINS A PTR TO IT
OUTVAL:	HRRZ	TA,CUREOP
	MOVE	TB,1(TA)	;GET TABLE LINK
	TRZ	TB,7B20		;DROP TABLE CODE
	ADD	TB,VALLOC##	;ADD START OF VALTAB
	HRLI	TB,440700	;MAKE IT INTO A BYTE PTR
	SETZB	TC,TD
	SETZ	TA,
	ILDB	TD,TB		;GET LENGTH OF ENTRY
OUT1:	IMULI	TC,^D10		;SHIFT NUMBER
	ILDB	TA,TB		;GET NEXT DIGIT
	SUBI	TA,"0"
	ADD	TC,TA
	SOJG	TD,OUT1
	MOVE	TB,TC		;PUT VALUE IN TB
OUTV2:	PUSHJ	PP,D1GEN	;OUTPUT IT AS FULL WORD
	MOVE	TB,ELITPC
	SOJA	TB,SWAP		;FORM LITAB PTR

;ROUTINE TO FIX A LITAB PC VALUE SO IT CAN BE OUTPUT
SWAP:	HRLZS	TB
FIXLIT:	TLO	TB,AS.LIT
	HRRI	TB,AS.MSC
	POPJ	PP,


GETTAB:	HRRZ	TA,CUREOP
	LDB	TB,[POINT 3,1(TA),20]	;GET TABLE CODE
	POPJ	PP,

	END