Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/13/cgpa.mac
There are 2 other files named cgpa.mac in the archive. Click here to see a list.
SUBTTL PARAMETER HANDLING ON CALLING SIDE
SALL
COMMENT;
AUTHOR: LARS ENDERIN 2-AUG-73
VERSION: 4 [7,24,31,34,47,64,73,111,212]
PURPOSE: CODE GENERATION
CONTENTS: GENERATORS FOR NODES IN EXPRESSION TREE:
ZNS NODES %BEGPB, %NEW, %PCALL
;
SEARCH SIMMAC,SIMMC2,SIMMCR,SIMRPA
CTITLE CGPA
EXTERN CAUS,CGAD,CGCA,CGCC,CGCO,CGVA,CGLO,CGLO1,CAUSTD
EXTERN YOPST
EXTERN CGRA,CGPD
EXTERN CADS,CAUD
EXTERN CGAS,CGG2,CGG3,CGG4,CGR2,CGR3,CGR4,CGSY
EXTERN O2AD,O2AF,O2GI
EXTERN CGIM,CGIM1,CGMO,CGMO1
EXTERN O2CF,O2DF,O2GA,O2GF,O2GR,O2GW,O2GWD,O2IV
EXTERN YCGFX1,YACTAB,YCGFX2,YFORSI,YLXIAC,YO2ADI,YO2ADF,YOPCOD
EXTERN YOPSTB,YOPSTP,YORFOR,YQRELR,YQRELT,YRELPT,YZHET,YRELCD
EXTERN YCGINS,YORACT,YORFX,YTAC,YZHBXC
EXTERN YGETAC,YRELAC ;[7]
EXTERN CABSTU,CGAC,CGRD,CGRN,CGCCCH
EXTERN YACTAB,YCGACT
EXTERN YCGPAF ;SWITCHES ONLY IN LEFT HALF
EXTERN YCGDBL,YPAFIX
; COMPILE OPDEFS
; ==============
OPDEF ALFIX [PUSHJ XPDP,O2AF] ;Allocate any free fixup no
OPDEF IFLR [CAIE X6,QLREAL] ;Skip if X6 = type code for long real
OPDEF LR [CAIN X6,QLREAL] ;Converse of IFLR
OPDEF OPAC [OP (XL1)] ;Modify val of index field by XL1
OPDEF OPZAC [OPZ (XL1)] ;Modify val of index field by XL1
OPDEF GENRLD [PUSHJ XPDP,CGRD]
; MACROS
DEFINE FIRSTOP=<LF XP1,ZNSZNO(XCUR)>
MACINIT
CGINIT
TWOSEG
RELOC 400K
INTERN .BEGPB,.NEW,.PCALL,CGACSA
;SWITCHES
;--------
DSW STHUNK,YCGPAF,1,0 ;ON IF ANY THUNK FOR CURRENT PARAMETER LIST
DSW SNOFML,YCGPAF,0,0 ;ON IF FORMALS NOT KNOWN
DSW SQUICK,YCGPAF,2,0 ;[7] On for QUICK procedure
;Local field definitions
DF CALLID,YCGPAF,12,17 ;[7] Id no of called QUICK procedure
OPDEF RH [POINT 18,0,35]
RH==RH
DEFINE RIGHTHALF(A)<
IFN <RH-<<$'A>&<777777B17>>>,
<CFAIL A IS NOT IN RH>>
;Local register designations
XK=X4 ;(FORMAL) KIND
XM=X5 ;(FORMAL) MODE
XT=X6 ;(FORMAL) TYPE
SUBTTL === BEGPB ===
COMMENT;
INPUT ASSERTION: THE DECLARATIONS HAVE BEEN PROCESSED, AND THE
BLOCK STACK INDICATES THE PREF BLK AS THE CURRENT ONE.
XZHE POINTS TO THE ZHE OF THE PBLOCK.
GENERATED CODE: MOVEI XSAC,prefixed block prototype
PUSHJ XPDP,CPSP
<Transmit any parameters>
;
.BEGPB: LF ,ZHEFIX(XZHE) ;Prototype fixup no
OP (MOVEI XSAC,)
GENFIX
GPUSHJ CPSP
LF XP1,ZNSZNO(,YOPST) ;Get ZID node of class
IFOFF ZNOLST(XP1) ;Has parameters if this is not the last node
EXEC CGPARM
L X1,YZHET
LF X1,ZHEFIX(X1) ;Define FIX+2 (start of decl coding)
LI X1,2(X1)
DEFIX
EXEC CAUSTD ;Update display index
RETURN
SUBTTL === NEW ===
COMMENT;
INPUT ASSERTION: XCUR POINTS TO A %NEW NODE (ZNS).
THE FIRST OPERAND IS THE ZID OF THE CLASS.
GENERATED CODE: :IF ANY RESULTS MUST BE SAVED:
[PUSHJ XPDP,CSSA
XWD no. of intermediate results,address of acs map]
PUSHJ XPDP,CPNE
XWD display offset,class prototype
<transfer any parameters and enter>
;
.NEW: FIRSTOP
;[47]
LF X2,ZIDZQU(XP1)
LF X1,ZQUZB(X2)
;CHECK IF SIMULATION OR SIMSET IN PREFIX CHAIN
LOOP
IF ;System class
IFOFF ZQUSYS(X2)
GOTO FALSE
THEN
IF ;Simulation or Simset
LF X0,ZQULID(X2) ;IDENTIFIER NUMBER
CAIN X0,QIDSIM
GOTO TRUE ;ERROR
CAIE X0,QIDSET
GOTO FALSE ;OK
THEN ;Generate error message at compile- and run-time
LF X2,ZIDZQU(XP1)
LF X1,ZQULID(X2)
ERRI1 QE,423 ;NEW XXXX IS AN ILLEGAL OBJECT GENERATOR
L [RTSERR QDSCON,QSORCER]
GENABS
GOTO .NEW01
FI
FI
AS
;CHECK IF PREFIX EXIST
LF X1,ZHBZHB(X1)
JUMPE X1,FALSE ;NO MORE PREFIX
LF X2,ZHBZQU(X1)
GOTO TRUE
SA
;[47] END
GETAC2
EXEC CGACSA ;CODE TO SAVE ACS, IF ANY
GPUSHJ (CPNE)
LF X2,ZIDZQU(XP1) ;ZQU of class
IF ;[111] Class decl AND its declaring block are both
; visible by connection
IFOFF ZQUIS(X2)
GOTO FALSE
LF X3,ZQUZHE(X2)
LF X1,ZHBZQU(X3)
IFOFF ZQUIS(X1)
GOTO FALSE
THEN ;Use DLV of declaring block
LFE X1,ZHEDLV(X3)
ELSE ;Use SBL of the class itself
LF X1,ZQUZB(X2)
LF X1,ZHBSBL(X1)
MOVN X1,X1
FI ;[111]
LF ,ZQUIND(X2) ;PROTOTYPE FIXUP
HRL X1 ;DISPLAY OFFSET
GENFIX ;XWD display offset,prototype of class
IFOFF ZNOLST(XP1)
EXEC CGPARM ;Handle parameters
RELAC2
.NEW01: ;[47]
RETURN
SUBTTL CGACSA - code to save intermediate results
COMMENT;
PURPOSE: TO GENERATE CODE TO SAVE INTERMEDIATE RESULTS, IF ANY
GENERATED CODE: (ONLY IF NECESSARY)
PUSHJ XPDP,CSSA
XWD number of intermediate results, address of map
;
CGACSA: PROC
SAVE X1
HRRZ YTAC
IF ;More than one ac on stack
CAIN YACTAB
GOTO FALSE
THEN ;Emit code to save ac's in ZAC object
GPUSHJ CSSA
EXEC CGAC
FI
SETZM YLXIAC ;Must assume XIAC destroyed after call
RETURN
EPROC
SUBTTL === PCALL ===
COMMENT;
INPUT ASSERTION: NODE %PCALL WITH OPERANDS:
ZID/ZNS NODE,FOLLOWED BY ANY PARM NODES WITH ACTUAL AND
FORMAL PARAMETER NODES AS SUBNODES.
GENERATED CODE: (1) SIMPLE CASE - STATICALLY VISIBLE PROCEDURE:
:IF ANY RESULTS MUST BE SAVED:
[PUSHJ XPDP,CSSA
XWD no. of intermediate results,address of acs map]
MOVEI XSAC,procedure prototype
PUSHJ XPDP,CSSN
[parameter transmission and procedure entry]
(2) MORE COMPLICATED CASES - PROC IN INSPECTED
CLASS, REMOTE, FORMAL, VIRTUAL OR NOCHECK PROCEDURE:
compute ZDP of procedure to XWAC1 & XWAC2
PUSHJ XPDP,CSSW or PUSHJ XPDP,CSSW0
XWD no. of intermediate results,address of acs map
[parameter transmission and procedure entry]
;
.PCALL: PROC
FIRSTOP
IF
RECTYPE(XP1) IS ZID
GOTO FALSE
LF X1,ZIDZQU(XP1)
LF X2,ZIDMOD(XP1)
IFOFF ZQUIS(X1) ;NOT MADE VISIBLE BY CONNECTION
CAIE X2,QDECLARED ;AND DECLARED
GOTO FALSE
LF X2,ZQUZB(X1)
JUMPE X2,FALSE
THEN ;Normal case (unless NOCHECK)
JSP X3,CGQIQS ;[7] Check for QUICK or sys calling sequence
IFON ZHBNCK(X2) ;[7]
GOTO L2 ;[7]
EXEC CGACSA ;Save any intermediate results
LF X1,ZIDZQU(XP1) ;------------------------;
LF ,ZQUIND(X1) ; MOVEI XSAC,proc. prot. ;
OP (MOVEI XSAC,) ; PUSHJ XPDP,CSSN ;
GENFIX ;------------------------;
GPUSHJ CSSN
ELSE
JSP X3,CGQISY ;[7] Check for sys calling sequence
;-------------------------------------------;
L2():! COMPVAL ;[7] ; Dyn addr of procedure to XWAC1+n, XWAC2+n ;
;[24] Generate PUSHJ XPDP,CSSW0 for formal or virtual
; procedure calls without parameter list
IF
IFEQF (XP1,ZIDMOD,QDECLARED)
GOTO FALSE
IFOFF ZNOLST(XP1)
GOTO FALSE
THEN
;-------------------------------;
GPUSHJ CSSW0 ; PUSHJ XPDP,CSSW0 ;
;-------------------------------;
ELSE
;-----------------------------------;
GPUSHJ CSSW ; PUSHJ XPDP,CSSW ;
;-----------------------------------;
FI
;-------------------------------------------;
EXEC CGAC ; XWD n,admap ;
;-------------------------------------------;
FI
IFOFF ZNOLST(XP1)
EXEC CGPARM ;Handle parameters
RELAC2
EXEC CGCCCH ;Possible SKIP instr if part of conditional
RETURN
EPROC
CGQIQS: LF ,ZHBMFO(X2) ;[7]
CAIN QEXMQI ;[7] QUICK procedure?
BRANCH CGQI ;[7] Treat specially
CGQISY: IFON ZQUSYS(XP1) ;[7]
BRANCH CGSY ;[7] System procedure
GETAC2 ;[7]
BRANCH (X3) ;[7] RETURN
SUBTTL [7] === CGQI === [7]
Comment/
Input assertion:
XP1 points to a ZID node for an external MACRO-10
procedure which should have a special quick calling
sequence similar to the calling sequences of Outtext,
Histo, Inint etc., i e parameters are passed in
successive registers, normally starting with XWAC1.
X1 :- ZIDZQU(XP1), X2:-ZQUZB(X1).
Generated code:
(1) Compute parameters to successive ac's starting with Xtop.
(2a) ;(with CHECK option):
MOVEI XTAC,Xtop ;Only for <type> procedure
(2b) ;(NOCHECK):
SKIPA XTAC,.+1
XWD -n, Xtop ;n = number of actual parameters
;or if n = 0:
MOVEI XTAC,Xtop
(3) PUSHJ XPDP,entry
/
CGQI: PROC
IF ;Parameters are checked
IFON ZHBNCK(X2)
GOTO FALSE
THEN
LF X3,ZHELEN(X2) ;Number of ac's needed = block length
IF ;Any ac's needed
JUMPLE X3,FALSE
THEN ;Compute parameters to successive ac's
EXEC CGQIPA
FI
LF X1,ZIDZQU(XP1)
LF ,ZQUTYP(X1)
IF ;Type procedure (function)
CAIN QNOTYPE
GOTO FALSE
THEN ;Tell the function which is the top ac
HRRZ @YTAC
OP (MOVEI XTAC,)
GENABS
FI
ELSE ;NOCHECK procedure
IF ;No parameters given
IFOFF ZNOLST(XP1)
GOTO FALSE
THEN ;Simple calling seq
STACK [0] ;Number of parameters
ELSE ;Compute parameters
STEP XP1,ZNS,X1
EXEC CGPANO
STACK X0 ;Number of parameters
L X3,X0
ADD X3,X0 ;Twice as many ac's needed
IF ;[34] Too many
CAIG X3,QNAC
GOTO FALSE
THEN ;Error
L X1,X3
ERRI1 QE,<Q2.ERR+66>
L [RTSERR QDSCON,QSORCER] ;[41]
GENABS
ELSE ;Handle parameters
LF X1,ZIDZQU(XP1) ;[34] Restore X1
EXEC CGQIPA
FI ;[34]
FI
UNSTK X1 ;Number of parameters
IF ;There were any
JUMPE X1,FALSE
THEN ;We need two instructions
LI 1
ADD YRELCD
OP (SKIPA XTAC,)
GENRLD ;[SKIPA XTAC,.+1]
MOVN X1
HRLZ
ELSE ;Just one instruction
OP (MOVEI XTAC,)
FI
HRR @YTAC ;Xtop
GENABS ;[XWD -n,Xtop] or [MOVEI XTAC,Xtop]
FI
LF X1,ZIDZQU(XP1) ;Generate PUSHJ to procedure entry
LF ,ZQUIND(X1) ;Fixup for entry point
OP (PUSHJ XPDP,)
GENFIX
SETZM YLXIAC ;XIAC will probably be destroyed
EXEC CGCCCH ;Possible skip instr if part of conditional
RETURN
EPROC
SUBTTL === CGQIPA === [7]
Comment;
Purpose: To compute parameters to successive ac's for a call on
a "QUICK" external procedure.
Input assertion: XP1 points to ZID of procedure, followed by a
parameter list, consisting of %PARM nodes,
each with an actual/formal parameter node pair as
subnodes. X3 has number of ac's needed for parameters.
X1 :- ZIDZQU of procedure. X2:-ZQUZB(X1).
Code generated: Actual parameter computation to ac's.
;
CGQIPA: PROC
SAVE <XP2,XV1,XV2,XL1,XL2> ;[34]
SETZM YLXIAC ;Make sure XIAC is reloaded when needed
STACK YCGDBL
STACK YCGPAF
HRRZS YCGPAF ;Reset switches
SETON SQUICK
IFON ZHBNCK(X2) ;[34]
SETON SNOFML
LF ,ZQULID(X1) ;Get lexical id of proc to use in case of error
SF ,CALLID
XCT YGETAC-1(X3) ;Reserve ac's for all parameters
STACK YTAC ;Save YACTAB status
STEP XP1,ZNS,XP2 ;XP2:-first %PARM node
LI XL2,QLOWID ;[34] Signifies parameter number: 1
LOOP
EXEC CGPA.1
AS IFON ZNOLST(XP2)
GOTO FALSE
STEP XP2,ZNS
AOJA XL2,TRUE ;[34] Count parameters
SA
UNSTK YTAC
XCT YRELAC ;Let go of ac's
UNSTK YCGPAF
UNSTK YCGDBL
RETURN
EPROC
SUBTTL === CGPARM ===
COMMENT;
PURPOSE: TRANSMITS PARAMETERS TO CLASSES, PREFIXED BLOCKS
AND PROCEDURES.
INPUT ASSERTION: XP1 POINTS TO ZID OF PROCEDURE OR CLASS, FOLLOWED
BY A PARAMETER LIST, CONSISTING OF %PARM NODES,
EACH WITH ACTUAL/FORMAL SUBNODES, OR, FOR PARAMETERS
TO FORMAL OR VIRTUAL PROCEDURES, AN ACTUAL PARAM. LIST.
THE ADDRESS OF THE OBJECT HAS BEEN COMPUTED TO XWAC1
BY CSSN, CSSW, CPNE OR CPSP.
CODE GENERATED: <parameter transmission>
PUSHJ XPDP,CSEN
;
CGPARM: PROC
SAVE <XP2,XV1,XV2,XL1>
EXEC CGPD ;Save ac stack description, start over
SETZM YLXIAC ;Make sure XIAC is reloaded when needed
STACK YCGPAF ;Save recursion data
STACK YCGDBL
STACK YPAFIX
L X1,YZHBXCB
LF ,ZHBSTD(X1) ;SAVE CURRENT STD
MOVN X2, ;IN MORE USEFUL FORM (NEGATED)
HRRZM X2,YCGPAF ;SWITCHES IN LEFT HALF ARE RESET
;[7] EXEC CGUSTD
STEP XP1,ZNS,XP2
IF ;ZNS(%PARM)
WHENNOT(XP2,ZNS)
GOTO FALSE
IFNEQF(XP2,ZNSGEN,%PARM)
GOTO FALSE
THEN
LI [BYTE (6)QZNS(2)0(4)QREF(3)QDECLARED(3)QSIMPLE
0]
; THE LITERAL ABOVE IS A DUMMY ZNS NODE USED TO
; DESCRIBE THE RETURNED PROCEDURE INSTANCE IN XWAC1
HRLM @YTAC ;Update YTAC
AOS YTAC
SETOFF SNOFML
ELSE ;Only actual parameters known
L X1,XP2
EXEC CGPANO ;Count parameters in X0
GENABS ;NUMBER OF PARAMETERS (Z n)
GPUSHJ (PHPT)
SETON SNOFML ;No formals known
FI
ALFIX ;ALLOCATE FIXUP FOR SKIPPING THUNKS
HRL YCGPAF
ST YPAFIX ;offset of object save loc,,fixup no.
LOOP ;For each actual parameter
EXEC CGPA.1
AS
IFON ZNOLST(XP2)
GOTO FALSE
STEP XP2,ZNS
GOTO TRUE
SA
GPUSHJ CSEN
L X1,YZHBXCB
MOVN YCGPAF
SF ,ZHBSTD(X1)
HRRZ X1,YPAFIX
CLFIX
UNSTK YPAFIX
UNSTK YCGDBL
UNSTK YCGPAF
EXEC CGRA ;Restore old ac stack description (YACTAB)
RETURN
EPROC
CGPANO: ;Count parameters starting at (X1)
LI 1 ;Count in X0
LOOP
HLL X1,OFFSET(ZNOLST)(X1)
ADDI X1,ZNO%S
AS ;long as we have more parameters
IFOFFA ZNOLST(X1)
AOJA TRUE
SA
RETURN
SUBTTL CGPA.R,CGUSTD,CGNQ
REPEAT 0,<
CGPA.R: PROC ;RECOVER POINTER TO CLASS/PROC/PBLK INSTANCE
;X2 HOLDS NUMBER OF AC TO GET THE OBJECT ADDRESS
HRRZ YCGPAF
OP (HLRZ (XCB))
DPB X2,[ACFIELD]
GENABS
LI X2,XWAC1
RETURN
EPROC
>
CGUSTD: PROC ;INCREASE STD BY 1, POSSIBLY UPDATE SZD (MAX STD VALUE)
;X1 POINTS TO ZHB. X2 IS DESTROYED.
SIZE (QMS,ZHBSTD)
LF ,ZHBSTD(X1)
LF X2,ZHBSZD(X1)
ADDI 1
CAIL <1_<QMS>>
ERROR2 50,DISPLAY SIZE OVERFLOW
CAMLE X2
SF ,ZHBSZD(X1)
SF ,ZHBSTD(X1)
RETURN
EPROC
CGNQ: ;Set ZFLZQU for id or expression of type REF
LF ,ZNSTYP(XP1)
CAIE QREF
RETURN
LF X1,ZNSZQU(XP1)
WHEN (XP1,ZNN) ;[1] If thunk was compiled
LF X1,ZNNZQU(XP1) ; use ZNNZQU instead of ZNSZQU
LF ,ZQUIND(X1) ;Fixup for qualif. prototype
OPAC (HRLI 1,)
GENFIX ;! HRLI Xtop+1,qualif. prototype !;
RETURN
SUBTTL === CGPA.1 ===
COMMENT;
PURPOSE: COMPILE CODE TO HANDLE TRANSMISSION OF ONE
PARAMETER TO A CLASS,PROCEDURE OR PREFIXED BLOCK.
INPUT ASSERTION: XP2 POINTS TO THE CURRENT %PARM NODE, OR IF ONLY
ACTUAL PARAMETERS ARE KNOWN,XP2 POINTS TO
THE FIRST ACTUAL PARAMETER.
;
CGPA.1: PROC
SAVE XP2
STACK XP1
HRRZ XL1,@YTAC ;[7] Prepare for OPAC, OPZAC
LSH XL1,5 ;[7]
HRLM XL1,YCGACT ;[7]
SETZM YCGDBL
IF ;FORMAL PARAMETER NOT KNOWN AT COMPILE TIME
IFOFF SNOFML
GOTO FALSE
THEN
L XP1,XP2
IF ;[7] not QUICK
IFON SQUICK
GOTO FALSE
THEN EXEC CGZAP
UNSTK XP1 ;[7]
ELSE ;[7] QUICK, fake formal node
EXEC CGPA.F ;Kind (XK), mode (XM), type (XT)
GOTO L1
FI ;[7]
ELSE
LF XP1,ZNSZNO(XP2) ;XP1:-ACTUAL PARM NODE
STEP XP1,ZNS,XP2 ;XP2:-FORMAL NODE
EXEC CGPA.F ;FORMAL(KIND, MODE, TYPE) TO (XK, XM, XT)
IF ;VALUE mode
CAIE XM,QVALUE
GOTO FALSE
THEN
EXEC CGPV
ELSE
IF ;REFERENCE mode
CAIE XM,QREFERENCE
GOTO FALSE
THEN
IF ;NOT AN ARRAY
CAIN XK,QARRAY
GOTO FALSE
THEN
IF ;KIND PROCEDURE
CAIE XK,QPROCEDURE
GOTO FALSE
THEN ;TWO WORDS DYNAMIC ADDRESS EXCEPT FOR SWITCH
CAIE XT,QLABEL
AOS YCGDBL
ELSE ;TWO WORDS FOR SIMPLE TEXT OR LABEL
CAIE XT,QTEXT
CAIN XT,QLABEL
AOS YCGDBL
FI
FI
COMPVAL
ELSE ;--- MUST BE BY NAME, THEN ---
ASSERT <CAIE XM,QNAME
RFAIL NONEXISTENT MODE>
L1():! IFON SQUICK ;[73] Must have correct YACTAB reference
HRLM XP1,@YTAC;(No COMPxxx proc will be called to do this)
EXEC CGPN
FI FI
UNSTK XP1 ;[7]
IF ;[7] Normal case
IFON SQUICK
GOTO FALSE
THEN ;[7]
;--- MOVE PARAMETER TO FORMAL POSITION.
;--- USE NEXT FREE AC FOR THE OBJECT ADDRESS
L X3,@YTAC
LI X2,XWAC1
LF X1,ZIDZQU(XP2)
LF ,ZQUIND(X1)
OP (MOVEM)
SKIPE YCGDBL
;***UWOBEG
;KA10 WARNING UNNECESSARY, SINCE DMOVEM IS IMPLEMENTED AS A UUO
; KA10WARNING
;***UWOEND
OP (DMOVEM)
DPB X2,[INDEXFIELD]
DPB X3,[ACFIELD]
GENABS
ELSE ;[7] Leave parameter in ac(s)
IF ;[73] Name mode transmission
LF XM,ZIDMOD(XP2)
CAIN XM,QNAME
GOTO TRUE
IFOFF SNOFML
GOTO FALSE
THEN ;Change node to ZNN node for "computed addr"
;This is to arrange for correct ac map when
;necessary for following parameter evaluations
HLRZ X1,@YTAC
LI ZNN%V
SF ,ZNOTYP(X1)
LI QCODCA
SF ,ZNNCOD(X1)
FI ;[73]
AOS YTAC
SKIPE YCGDBL
AOS YTAC
FI ;[7]
FI
RETURN
EPROC
SUBTTL === CGPN ===
COMMENT;
PURPOSE: COMPILE ZFL TO Xtop & Xtop+1.
A THUNK IS COMPILED IF NECESSARY.
INPUT ASSERTION: THE FORMAL PARAMETER IS KNOWN AND SPECIFIED NAME.
XP1 POINTS TO THE ACTUAL PARAMETER NODE.
;
CGPN: PROC
ASSERT <RIGHTHALF ZFLZBI>
AOS YCGDBL ;ALWAYS TWO WORDS FOR NAME PARAMETER
L X3,@YTAC
LF ,ZNOTYP(XP1) ;[64] Node type
CAIN QZNS ;[31]
BRANCH CGNX ;[31] ZNS node implies expression
;--- CHECK FOR CONSTANT PARAMETER ---
CAIN QZCN
BRANCH CGNC
;--- CHECK FOR NAME PARAMETER AS ACTUAL PARAMETER ---
LF X1,ZIDMOD(XP1)
CAIN X1,QNAME
BRANCH CGNN
ASSERT <
CAIE QZID ;[64] If not ZID node here, something is fishy
RFAIL CGPN not ZID
>
;--- CHECK IF ZID NODE NEEDS THUNK ---
LF ,ZIDKND(XP1)
LF X1,ZIDTYP(XP1)
;PROCEDURE, SWITCH OR LABEL
CAIE QPROCEDURE
CAIN X1,QLABEL
BRANCH CGNX
;--- SIMPLE TYPE OF DESCRIPTOR HERE ---
BRANCH CGNS
EPROC
SUBTTL === CGPV ===
COMMENT;
PURPOSE: COMPILE VALUE OF PARAMETER TO Xtop & Xtop+1.
INPUT ASSERTION: XP1 POINTS TO AN ACTUAL PARAMETER NODE. THE
CORRESPONDING FORMAL PARAMETER IS SPECIFIED VALUE.
TYPE AND KIND OF FORMAL ARE IN XK,XT.
;
CGPV: PROC
IF ;Simple value type
CAIG XT,QBOOLEAN
CAIE XK,QSIMPLE
GOTO FALSE
THEN ;Compute the value
CAIN XT,QLREAL
AOS YCGDBL
COMPVAL
ELSE
IF ;ARRAY
CAIE XK,QARRAY
GOTO FALSE
THEN ;Use CSCA with inline acs descriptor ;[7]
COMPVAL
GPUSHJ (CSCA) ;COPY ARRAY OBJECT
EXEC CGAC ;[n,,admap]
ELSE
IF CAIE XT,QTEXT
GOTO FALSE
THEN
AOS YCGDBL
COMPVAL
GPUSHJ (TXCY) ;COPY THE TEXT OBJECT
EXEC CGAC ;[7] XWD n,admap
ASSERT<
ELSE
RFAIL <REF LABEL OR NOTYPE ILLEGAL BY VALUE>
>
FI FI FI
RETURN
EPROC
SUBTTL === CGNN ===
COMMENT;
PURPOSE: TO GENERATE CODE FOR PASSING A NAME PARAMETER
TO A PROCEDURE, WHEN THE ACTUAL PARAMETER IS ALSO
SPECIFIED BY NAME ON THE CALLING SIDE
INPUT ASSERTION: X3=Xtop
;
CGNN: PROC
LF X1,ZIDZQU(XP1)
GETAD
OPZ (DMOVE)
ST YOPCOD
GENOP
LF X2,ZIDTYP(XP1)
IF ;ACTUAL TYPE =/= FORMAL TYPE
CAIN XT,(X2)
GOTO FALSE
THEN ;MODIFY ZFLFTP, ZFLCNV
;! MOVEI Xtop+2,formal type code !;
L XT
OPAC (MOVEI 2,)
GENABS
;! DPB Xtop+2,[$ZFLCTP(Xtop)] !; CNV BIT CLEARED WITH ZFLFTP
MOVSI ($ZFLCTP) ;[212]
ADDI (X3) ;[212]
GENWRD
OPAC (DPB 2,)
GENREL
;! LDB Xtop+3,[$ZFLATP(Xtop)] !;
MOVSI ($ZFLATP) ;[212]
ADDI (X3) ;[212]
GENWRD
OPAC (LDB 3,)
GENREL
;! CAIE Xtop+3,formal type code !;
L XT
OPAC (CAIE 3,)
GENABS
;! TLO Xtop,(1B<%ZFLCNV>) !;
LI (1B<%ZFLCNV>)
OPAC (TLO)
GENABS
FI
IF ;[7] QUICK procedure
IFOFF SQUICK
GOTO FALSE
THEN ;Must guard against unequal types or thunk
LI (1B<%ZFLCNV>)
OPAC (TLNN) ;! TLNN Xtop,(1B<%ZFLCNV>)
GENABS
LI (1B<%ZFLNTH>)
OPAC (TLNN) ;! TLNN Xtop,(1B<%ZFLNTH>)
GENABS
L [RTSERROR 102] ;Complicated parameter to QUICK proc
GENABS
FI ;[7]
RETURN
EPROC
SUBTTL === CGNS ===
COMMENT;
PURPOSE: COMPILE ZFL TO Xtop & Xtop+1 FOR SIMPLE VARIABLE,
ARRAY OR TEXT.
INPUT ASSERTION: XP1 POINTS TO A ZID NODE WHICH IS NOT FOR A PROCEDURE,
LABEL OR SWITCH.
CODE GENERATED: MOVSI Xtop,ZFL flags
HRR Xtop,display displ. of declaring block(XCB)
MOVEI Xtop+1,offset of actual parameter in its block
For a REF quantity:
HRLI Xtop+1,prototype address
;
CGNS: PROC
MOVSI X2,(<QDTVSI>B<%ZFLDTP>)
EXEC CGFL1
;CODE TO LOAD BLOCK INSTANCE OF PARAMETER FROM DISPLAY OF XCB
LF X2,ZIDZQU(XP1)
LF X1,ZQUZHE(X2)
LF ,ZHEDLV(X1)
OPAC (HRR (XCB))
GENABS ;! HRR Xtop,display level(XCB) !;
LF ,ZQUIND(X2)
OPAC (MOVEI 1,)
GENABS ;! MOVEI Xtop+1,offset of actual parameter !;
BRANCH CGNQ ;Compile ZFLZQU if REF
EPROC
SUBTTL === CGNC ===
COMMENT;
PURPOSE: COMPILE FORMAL LOCATION FOR CONSTANT
INPUT ASSERTION: XP1 POINTS TO ZCN NODE FOR THE ACTUAL PARAMETER
CODE GENERATED: MOVSI Xtop,ZFL flags
MOVEI Xtop+1, address of constant
;
CGNC: PROC
OPZAC XV1,(MOVEI 1,)
MOVSI X2,(<QDTCON>B<%ZFLDTP>)
EXEC CGFL1
LF X1,ZIDTYP(XP1)
EXEC CGPAGC
RETURN
EPROC
SUBTTL === CGPAGC ===
COMMENT;
PURPOSE: GENERATE A LITERAL CONSTANT IF NECESSARY AND COMPILE
A RELOCATABLE INSTRUCTION WITH THE ADDRESS OF THE
CONSTANT IN THE RIGHT HALF, AND THE LEFT HALF AS
SUPPLIED BY XV1 LEFT HALF.
INPUT ASSERTION: XP1 POINTS TO A ZCN NODE FOR AN ACTUAL PARAMETER.
;
CGPAGC: PROC
IF CAIE X1,QTEXT
GOTO FALSE
THEN
COMPAD ;NOTE THE SPECIAL USE MADE OF COMPAD FOR TEXT CONSTANT
ELSE
WLF ,ZCNVAL(XP1)
IF
CAIE X1,QLREAL
GOTO FALSE
THEN
;***UWOBEG
;AVOID INDIRECTION IN LD MACRO, BY USING X1 FOR INTERMEDIATE. X1 IS
;AVAILABLE SINCE IT IS LOADED BY THE SECOND DMOVE OF THE LD EXPANSION
IFN QKI10,< LD @>
IFN QKA10,< LI X1,@X0
LD X0,(X1)>
;***UWOEND
GENDW
ELSE
GENWRD
FI
HLL XV1
GENREL ;! opcode or left hw,address of constant !;
FI
RETURN
EPROC
SUBTTL === CGNX ===
COMMENT;
PURPOSE: COMPILE THUNK AND FORMAL LOCATION FOR AN ACTUAL
PARAMETER CORRESPONDING TO A FORMAL PARAMETER BY NAME,
WHEN THE ACTUAL PARAMETER HAS A ZNS NODE OR IS
A PROCEDURE, LABEL OR SWITCH.
;
CGNX: PROC
IF ;[7] QUICK procedure
IFOFF SQUICK
GOTO FALSE
THEN ;Cannot handle it - error
L X1,XL2 ;[34] Param identification
LF X2,CALLID ;Id no of procedure
ERRI2 QE,<Q2.ERR+67> ;[34] Too complicated
L [RTSERROR QDSCON,QSORCER];Prevent execution ;[41]
GENABS
RETURN
FI ;[7]
;ALWAYS GENERATE A THUNK
HRRZ YPAFIX
OPAC (JSP 1,)
GENFIX ;! JSP Xtop+1,past thunk !;
EXEC CGPA.F
EXEC CGTHUNK
EXEC CGPAFX
EXEC CGPA.F
L X2,XV1
EXEC CGFL2
HRRZ @YTAC
OP (HRRM XCB,)
GENABS ;! HRRM XCB,Xtop !;
BRANCH CGNQ ;Compile ZFLZQU for REF
EPROC
COMMENT;
PURPOSE: LOAD KIND,MODE,TYPE OF XP2 NODE TO XK,XM,XT
;
CGPA.F: PROC
LF XM,ZIDMOD(XP2)
LF XK,ZIDKND(XP2)
LF XT,ZIDTYP(XP2)
RETURN
EPROC
SUBTTL === CGPADT ===
COMMENT;
PURPOSE: DETERMINE IF AN ACTUAL PARAMETER EXPRESSION SHOULD YIELD
A DYNAMIC ADDRESS OR AN EXPRESSION VALUE, GIVEN THAT A
THUNK WILL BE COMPILED, I E THE SIMPLEST CASES HAVE BEEN
DEALT WITH ALREADY.
INPUT: XP1 POINTS TO ACTUAL PARAMETER NODE
OUTPUT: X1 = (<qdt>B<%ZAPDTP>), WHERE qdt= QDTDYN OR QDTEXP.
;
IFN <%ZAPDTP-%ZFLDTP>,<CFAIL CGPADT FAILURE>
CGPADT: PROC
LI X1,(<QDTDYN>B<%ZFLDTP>) ;DYNAMIC ADDRESS IF
LF ,ZNSKND(XP1)
CAIN QARRAY
GOTO L1 ; VALUE FOR ARRAYS
CAIE QSIMPLE ;KIND IS NOT SIMPLE
RETURN
LF ,ZNSTYP(XP1)
CAIN QLABEL ;OR TYPE IS LABEL
RETURN
LF ,ZNSGEN(XP1)
CAIE %RP
CAIN %DOT
RETURN
L1(): LI X1,(<QDTEXP>B<%ZFLDTP>) ;OTHERWISE EXPRESSION
RETURN
EPROC
SUBTTL === CGTHUNK ===
COMMENT;
PURPOSE: COMPILE THUNK FOR AN ACTUAL PARAMETER POINTED TO BY XP1.
INPUT ASSERTION: XP1 POINTS TO THE ACTUAL PARAMETER NODE.
OUTPUT ASSERTION: A THUNK HAS BEEN COMPILED. THE DESCRIPTOR TYPE
ZFLDTP OR ZAPDTP IS PLACED IN XV1 IN THE PROPER FIELD.
XV1 IS OTHERWISE ZERO.
GENERATED CODE: XWD displacement of thunk save area,0 or next ZAP address
<code for thunk>
JRST @ZTSRAD(XCB)
;
CGTHUNK:PROC
STACK YACTAB
IFOFF SNOFML
SOS YTAC
SUBI XL1,(Z 1,)
HRLM XL1,YCGACT
SETZM YLXIAC
L YPAFIX
GENFIX ;! XWD displacement of thunk save area,0 or next ZAP address !;
IF
IFON STHUNK
GOTO FALSE
THEN ;MUST ALLOCATE THUNK SAVE AREA
SETON STHUNK ;- BUT ONLY ONCE
LI X3,ZTS%S ;[7] Reserve space in display
L X1,YZHBXCB ;of XCB
LOOP
EXEC CGUSTD
AS SOJG X3,TRUE
SA
FI
EXEC CGPADT
IF CAIE X1,(<QDTEXP>B<%ZFLDTP>)
GOTO FALSE
THEN
COMPVAL
MOVSI XV1,(<QDTEXP>B<%ZFLDTP>)
ELSE
COMPCA
MOVSI XV1,(<QDTDYN>B<%ZFLDTP>)
FI
LF X1,ZNSKND(XP1)
LF X2,ZNSMOD(XP1)
LF X3,ZNSTYP(XP1)
HRRZ X4,YCGPAF
EXEC CGPA.T ;POSSIBLE RESTORE OF XSAC
IF
CAIN X1,QPROCEDURE
CAIN X3,QLABEL
GOTO FALSE
THEN
IF CAIE X2,QDECLARED
GOTO TRUE
IF WHEN XP1,ZID
GOTO FALSE
THEN; REMOTE PROCEDURE
LF X1,ZNSZNO(XP1)
STEP X1,ZID
ELSE; DECLARED PROCEDURE
L X1,XP1
FI
LF X1,ZIDZQU(X1)
LF X1,ZQUZB(X1)
LF X1,ZHBNRP(X1)
JUMPN X1,FALSE
THEN ;SPECIAL THUNK FOR PROCEDURE WITHOUT PARAMETERS
LI <OFFSET(ZTSRAD)>(X4)
OP (JSP @(XCB))
GENABS
GPUSHJ (CSSW) ;GET PROCEDURE VALUE ON RETURN
SETZ ;DUMMY ACS MAP
GENABS
EXEC CGPA.U ;UNCONDITIONAL XSAC RESTORE
FI FI
LI <OFFSET(ZTSRAD)>(X4)
OP (JSP @(XCB))
GENABS
UNSTK YACTAB
ADDI XL1,(Z 1,)
HRLM XL1,YCGACT
IFOFF SNOFML
AOS YTAC
RETURN
EPROC
SUBTTL === CGFL ===
COMMENT;
PURPOSE: COMPILE 1ST HALFWORD OF A ZFL TO Xtop.
INPUT ASSERTION: X2 HAS ZFLDTP SET, OTHERWISE ZERO. XP1 POINTS TO ACTUAL
PARAMETER NODE. XT=TYPE OF FORMAL PARAMETER.
;
CGFL: PROC ;GENERATE 1ST HALFWORD OF ZFL IN X2 (ZFLDTP ALREADY SET)
CGFL1: SETONA ZFLNTH(X2) ;NO THUNK WHEN ENTERING HERE
CGFL2: LF X1,ZIDTYP(XP1)
SF X1,ZFLATP(,X2)
SF XT,ZFLFTP(,X2)
IF ;Types are unequal
CAIN X1,(XT)
GOTO FALSE
THEN ;[7] Error if QUICK procedure
IF IFOFF SQUICK
GOTO FALSE
THEN L X1,XL2 ;[34] Identification of parameter
STACK X2
LF X2,CALLID ;Id no of procedure
ERRI2 QE,<Q2.ERR+70> ;[34]
UNSTK X2
L [RTSERROR QDSCON,QSORCER] ;[41]
GENABS
FI
SETONA ZFLCNV(X2)
FI
LF X1,ZIDKND(XP1)
SF X1,ZFLAKD(,X2)
HLR X2
OP (MOVSI)
ADD YCGACT
GENABS ;! MOVSI Xtop, ZFL codes!;
RETURN
EPROC
COMMENT;
PURPOSE: DEFINE, CLEAR AND REALLOCATE YPAFIX
;
CGPAFX: PROC
HRRZ X1,YPAFIX
DEFIX
HRRZ X1,YPAFIX
CLFIX
ALFIX
HRRM YPAFIX
RETURN
EPROC
COMMENT;
PURPOSE: MAKE XSAC POINT TO THUNK SAVE AREA
;
CGPA.T: PROC
;; CONDITIONAL GENERATION OF INSTRUCTION TO RESTORE XSAC -
;; CONDITION NOT YET DETERMINED
CGPA.U: SAVE <X1>
LI (X4)
OP (MOVEI XSAC,(XCB))
GENABS
RETURN
EPROC
SUBTTL === CGZAP ===
COMMENT;
PURPOSE: COMPUTE ZAP INSTANCE (ACTUAL PARAMETER DESCRIPTOR)
FOR THE NODE POINTED TO BY XP1. EACH DESCRIPTOR
IS FOLLOWED BY A LINK WORD,WHOSE LEFT HALF IS THE OFFSET
OF THE LOCATION IN DISPLAY(XCB) WHERE THE OBJECT ADDRESS
IS SAVED DURING PARAMETER EVALUATION.
;
CGZAP: PROC
SETZ XV1,
L XP2,XP1
EXEC CGPA.F ;LOAD KIND, MODE, TYPE (XK, XM, XT)
SF XK,ZPDKND(,XV1)
SF XT,ZTDTYP(,XV1)
IF ;TYPE REFERENCE, MUST HAVE QUALIFICATION
CAIE XT,QREF
GOTO FALSE
THEN
LF X1,ZNSZQU(XP1)
LF ,ZQUIND(X1)
GENFIX ;! XWD 0,qualif. prototype !;
FI
EXEC CGPAFX ;Define previous fixup, if any
LF X1,ZNOTYP(XP1)
SETONA ZAPNTH(XV1) ;ASSUME NO THUNK
IF ;ZNO OR ZCN NODE
CAIN X1,QZNS
GOTO FALSE
THEN
IF ;CONSTANT
CAIE X1,QZCN
GOTO FALSE
THEN
TLO XV1,(<QDTCON>B<%ZAPDTP>)
L X1,XT
EXEC CGPAGC
ELSE ;MUST BE ZID
ASSERT <WHENNOT XP1,ZID
RFAIL CGZAP MEMOP NOT ZID>
IF ;[64] Array, name param, or simple but not label
CAIE XK,QARRAY ;[64]
CAIN XM,QNAME
GOTO TRUE
CAIN XT,QLABEL
GOTO FALSE
CAIE XK,QSIMPLE
GOTO FALSE
THEN ;Make a NOTHUNK descriptor
LI X1,(<QDTVSI>B<%ZAPDTP>)
CAIN XM,QNAME
LI X1,(<QDTFNM>B<%ZAPDTP>)
TLO XV1,(X1)
LF X1,ZIDZQU(XP1)
LF X2,ZQUZHE(X1)
LF ,ZHEDLV(X2)
MOVN ;EBL CAN NOT BE USED FOR INSPECTED QUANT
SF ,ZAPEBL(,XV1)
LF ,ZQUIND(X1)
HLL XV1
GENABS
ELSE
LI X1,(<QDTDYN>B<%ZAPDTP>)
GOTO L2
FI
FI
L YPAFIX
GENFIX ;CHAIN TO NEXT ZAP
ELSE ;EXPRESSION
;[73] (Useless) LF XP2,ZNSZNO(XP1)
EXEC CGPA.F
EXEC CGPADT
L2():! TLO XV1,(X1)
SETOFA ZAPNTH(XV1) ;INDICATE PRESENCE OF THUNK
HRR XV1,YRELCD ;THUNK ADDRESS
ADDI XV1,1
L XV1
GENRLD ;ZAP
EXEC CGTHUNK
FI
IF ;LAST PARAMETER
IFOFF ZNOLST(XP1)
GOTO FALSE
THEN
EXEC CGPAFX
SETZ
GENABS ;END OF CHAIN
FI
RETURN
EPROC
LIT
RELOC
VAR
END