Trailing-Edge
-
PDP-10 Archives
-
BB-H506E-SM
-
cobol/source/mesgen.mac
There are 7 other files named mesgen.mac in the archive. Click here to see a list.
; UPD ID= 3157 on 9/29/80 at 4:05 PM by NIXON
TITLE MESGEN FOR COBOL V12C
SUBTTL GENERATORS FOR MCS & TCS VERBS SUMNER BLOUNT/CAM
SEARCH COPYRT
SALL
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
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
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
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, FNDPOP, LITNN, MCSCTR
EXTERNAL TB.VAL, TB.DAT, EMODEA, D1MODE, FATAL
EXTERNAL DSMODE
IFN MCS!TCS,< EXTERNAL CDLOC,M.AFLG>
;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
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: SETZ TA, ;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
IFN ANS68,<
JRST CSEQGN ;OUTPUT "MOVEI 16,LITNN
; PUSHJ PP,ROUTINE"
>
IFN ANS74,<
JUMPE TB,DBGEN ;NORMAL CODE IF NO DATA FLAG IS NOT SET
MOVE TB,TA ;NO DATA FLAG, SAVE ROUTINE NAME
MOVE TA,CURCD
LDB TA,CD.DUP## ;DO WE NEED TO DEBUG?
EXCH TB,TA
JUMPE TB,CSEQGN ;NO
HLLZ TB,CURCD ;CD-LINK
HRRI TB,DBCD.##
MOVEM TB,DBSPIF## ;INDICATE TO BE DONE AFTER SPIF
MOVEM W1,DBSPIF+1 ;SAVE LINE NUMBER
JRST CSEQGN ;AND GENERATE RECEIVE
>
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: MOVE CH,[MOVEI.##+AC16+ASINC,,AS.MSC##]
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.
;[68] EQUIVALENT TO CSEQGN
;[74] GENERATE DEBUGGING CODE IF REQUIRED
IFN ANS68,<DBGEN==CSEQGN>
IFN ANS74,<
IFN MCS!TCS,<
DBGEN: PUSHJ PP,CSEQGN
MOVE TA,CURCD ;GET CDTAB
LDB TB,CD.DUP## ;NEED TO DEBUG?
JUMPE TB,CPOPJ## ;NO
MOVEI CH,DBCD.##
PUSHJ PP,PUT.PJ## ;PUSHJ 17,DBCD.
MOVE CH,[AS.XWD##,,1]
PUSHJ PP,PUTASN
LDB CH,W1LN## ;GET LINE NUMBER
PUSHJ PP,PUTASN
DBGEN1::LDB CH,CD.FDL## ;GET FAKE DATAB LINK
ANDI CH,077777
PUSHJ PP,PUTASY
MOVE CH,[AS.XWD,,1]
PUSHJ PP,PUTASN
SETZ CH,
PUSHJ PP,PUTASN
LDB TA,CD.DUP ;DEBUG USE PROCEDURE
ADD TA,USELOC##
LDB CH,US.PRO## ;PROTAB LINK TO USE PROCEDURE
JRST PUTASY
>;END IFN MCS!TCS
>;END IFN ANS74
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
HRRZ TB,1(TC) ;GET TABLE LINK
JUMPE TB,ARG.00 ;ERROR SOMEWHERE IF ZERO, SO GIVE UP
LDB TD,[POINT 3,TB,20]
JUMPE TD,ARG.0 ;ZERO TABLE CODE? YES, ITS A CD-ENTRY
CAIE TD,TB.DAT## ;DATAB?
CAIN TD,TB.VAL## ;VALTAB?
JRST ARG.0A ;YES
ARG.00: OUTSTR [ASCIZ /?Invalid data-type--PTRGEN
/]
POPJ PP,
ARG.0:
IFE MCS!TCS,<
OUTSTR [ASCIZ /?INVALID CD-entry at PTRGEN
/]
>
IFN MCS!TCS,<
ADD TB,CDLOC##
IFN ANS74,<
HRL TB,1(TC) ;GET CDTAB OFFSET
MOVEM TB,CURCD## ;SAVE IT FOR DEBUG
>
MOVE TA,TB ;GET RIGHT ACC
LDB TA,CD.RDL## ;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
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: MOVE CH,[MOVEM.##+AC12+ASINC,,AS.MSC] ;OUTPUT "MOVEM 12,%PARAM+N"
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
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
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
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
SETZ TA,
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 DBGEN ;..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
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
LDB TB,[POINT 1,W1,9]
MOVEI TA,M.AC## ;GET ROUTINE ADDRESS
SKIPE TB
HRRZI TA,M.IFM## ;OR, THE OTHER ONE
JRST DBGEN ;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
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
TLNE W1,1B28 ;YES, IS IT "PAGE"?
JRST SEND81 ;YES
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 SEND82 ;YES
LDB LN,[POINT 13,W2,28]
LDB CP,[POINT 7,W2,35]
MOVEI DW,E.463 ;BAD MNEMONIC ERROR
JRST FATAL##
SEND81: MOVEI TB,1 ;SET UP "XWD 1,0"
SEND82: 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 ;CODE=000
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 DBGEN
OPERR: MOVE TA,MCSCTR
CAIN TA,3
JRST ARG5
OUTSTR [ASCIZ /?Fatal--operand error--MCSGEN
/]
JRST BADEOP
TABERR: OUTSTR [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,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