Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/13/cgcw.mac
There are 2 other files named cgcw.mac in the archive. Click here to see a list.
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
AUTHOR: CLAES WIHLBORG
UPDATED AT ACADIA UNIVERSITY FOR KA10
VERSION: 4 [7,41,270]
PURPOSE: TO GENERATE CODE FOR THE SYSTEM PROCEDURE CALLS
THE MODULE IS PART OF CODE GENERATION IN COMPILER PASS 2
IT IS CALLED FROM .PCALL IN CGPA
CONTENTS: CGSY- COMMON ENTRY
CGSYC- CLASS ATTRIBUTES
CGSYM- MATHEMATICAL SUBROUTINES
CGSYP- MISC. PROCEDURES
CGSYT- TEXT ATTRIBUTES
CGSYI1- ABS
CGSYI2- CHAR
CGSYI3- DIGIT
CGSYI4- ENTIER
CGSYI5- LETTER
CGSYI6- MOD
CGSYI7- RANK
CGSYI8- SIGN
CGSYI9- DETACH
CGSYK1- TIME SIMULATION
CGSYK2- LENGTH FILE
CGSYK3- MORE FILE
CGSYK4- POS FILE
CGSYK5- SETPOS FILE
CGSYK6- LOCATION DIRECTFILE
CGSYK7- SYSIN
CGSYK8- SYSOUT
CGSYK9- LENGTH TEXT
CGSYL1- MORE TEXT
CGSYL2- POS TEXT
CGSYL3- IDLE PROCESS
CGSYL4- TERMINATED PROCESS
CGSYL5- CURRENT SIMULATION
CGSYL6- ENDFILE INFILE
CGSYL7- LINE PRINTFILE
CGSYL8- FIRST HEAD
CGSYL9- LAST HEAD
CGSYM1- PREV LINKAGE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SEARCH SIMMC2,SIMMCR,SIMMAC,SIMRPA
SALL
CTITLE CGCW
SUBTTL PROLOGUE
TWOSEG
RELOC 400K
MACINIT
CGINIT
INTERN CGSY
EXTERN YTAC,YQRELR,YRELCD,YOPCODE,YLXIAC,YBKSTP,YELIN2,YO2ADI,YWARCT
EXTERN O2GI,O2GW,O2GA,O2GR,CGCCCH
EXTERN O2AD,CGVA,CGAD
EXTERN CGG2,CGR2,CGRD
EXTERN CGAA,CGAC
EXTERN CADS,CGCA,CGCC,CGCO,CGG3,CGG4
EXTERN CGIM,CGIM1,CGLO,CGLO1,CGMO,CGMO1,CGR3,CGR4
EXTERN O2CF,O2DF,O2GF,O2GWD,O2IV
edit(7)
EXTERN CGG6,CGG7,CGG8,CGG9,CGG10 ;[7]
OPDEF MAKEAD [PUSHJ XPDP,CGAA]
edit(7)
OPDEF GETAC6 [PUSHJ XPDP,CGG6##] ;[7]
OPDEF GETAC7 [PUSHJ XPDP,CGG7##] ;[7]
OPDEF GETAC8 [PUSHJ XPDP,CGG8##] ;[7]
OPDEF GETAC9 [PUSHJ XPDP,CGG9##] ;[7]
OPDEF GETACA [PUSHJ XPDP,CGG10##] ;[7]
OPDEF GETAC5 [PUSHJ XPDP,CGG5##]
OPDEF RELAC5 [PUSHJ XPDP,CGR5##]
OPDEF SYSEXIT [GOTO CGSYEX]
OPDEF ACSMAP [PUSHJ XPDP,CGAC]
OPDEF GETREST [GOTO CGSYS2]
OPDEF GETTREST [GOTO CGSYS3]
OPDEF SETAC [TLO 0(XL1)]
OPDEF OPAC [OP (XL1)]
OPDEF OPZAC [OPZ (XL1)]
OPDEF GETPARM [PUSHJ XPDP,CGSYS1]
DEFINE BROTHER(A,B) <LI A,2(B)>
DEFINE SON(A,B) <LF A,ZNSZNO(B)>
DEFINE NEPHEW(A,B) <BROTHE A,B
SON A,A>
DEFINE COMPAA<
COMPAD
L X1,YTAC
L (X1)
MAKEAD
>
DEFINE GETTEXT<
GETAC2
L XL1,@YTAC
HRLZI XL2,1(XL1)
ASH XL1,5
SUBI XP1,2
COMPVAL
>
DEFINE GETCLASS<
SON XP2,XCUR
IF CAME XP1,XP2
GOTO FALSE
THEN
COMPAD
ELSE
SON XP1,XP2
COMPVAL
FI
>
YGETAC::NOP
GETAC2
GETAC3
GETAC4
GETAC5
GETAC6 ;[7]
GETAC7 ;[7]
GETAC8 ;[7]
GETAC9 ;[7]
GETACA ;[7]
YRELAC::NOP
RELAC2
RELAC3
RELAC4
RELAC5
SUBTTL CGSY
CGSY:
PROC
SAVE <XP1,XP2,XL1,XL2,XV1>
SON XP1,XCUR
IF WHEN XP1,ZID
GOTO FALSE
THEN ;XP1 POINTS TO DOT NODE
SON XP1,XP1
BROTHER XP1,XP1
FI
;XP1 POINTS TO PROCEDURE ZID NODE
L XL1,@YTAC
LSH XL1,5
LF XV1,ZIDZQU(XP1)
LF X1,ZQUSNR(XV1)
GOTO @.+1(X1)
CGSYC ;CLASS ATTRIBUTES
CGSYM ;MATHEMATICAL SUBROUTINES
CGSYP ;MISC. PROCEDURES
CGSYT ;TEXT ATTRIBUTES
CGSYI1 ;ABS
CGSYI2 ;CHAR
CGSYI3 ;DIGIT
CGSYI4 ;ENTIER
CGSYI5 ;LETTER
CGSYI6 ;MOD
CGSYI7 ;RANK
CGSYI8 ;SIGN
CGSYI9 ;DETACH
CGSYK1 ;TIME SIMULATION
CGSYK2 ;LENGTH FILE
CGSYK3 ;MORE FILE
CGSYK4 ;POS FILE
CGSYK5 ;SETPOS FILE
CGSYK6 ;LOCATION DIRECTFILE
CGSYK7 ;SYSIN
CGSYK8 ;SYSOUT
CGSYK9 ;LENGTH
CGSYL1 ;MORE
CGSYL2 ;POS
CGSYL3 ;IDLE PROCESS
CGSYL4 ;TERMINATED PROCESS
CGSYL5 ;CURRENT SIMULATION
CGSYL6 ;ENDFILE INFILE
CGSYL7 ;LINE PRINTFILE
CGSYL8 ;FIRST HEAD
CGSYL9 ;LAST HEAD
CGSYM1 ;PREV LINKAGE
CGSYEX: EXEC CGCCCH
RETURN
EPROC
SUBTTL PROCEDURE ABS
CGSYI1:
;GENERATE CODE FOR THE SYSTEM PROCEDURE ABS
;ACCORDING TO THE FOLLOWING PATTERN:
;IF NOT LONG AND MEMOP
; MOVM XTOP,ARG
;
;IF NOT LONG AND NOT MEMOP
; COMPVAL
; MOVM XTOP,XTOP
;
;IF LONG
; COMPVAL
; CAIGE XTOP,0
;***AUBEG
; IFN QKI10,< DMOVN XTOP,XTOP>
; IFN QKA10,< DFN XTOP,XTOP+1>
;***AUEND
NEPHEW XP1,XP1
L X1,XP1
IF LONG
GOTO FALSE
THEN ;LONG REAL
COMPVAL
OPZAC (CAIGE)
GENABS
L @YTAC
;***AUBEG
IFN QKI10,< OPAC (DMOVN)>
IFN QKA10,< AOJ ;INCREMENT ADDRESS FOR DFN
OPAC (DFN)>
;***AUEND
GENABS
ELSE ;REAL
IF MEMOP
GOTO FALSE
THEN
IF RECTYPE(XP1) IS ZCN
GOTO FALSE
THEN
;???? OF QUESTIONABLE VALUE/SA
LF ,ZCNVAL(XP1)
GENWRD
OPAC (MOVM)
GENREL
ELSE
LF X1,ZIDZQU(XP1)
GETAD
OPZAC (MOVM)
ST YOPCODE
GENOP
FI
ELSE
COMPVAL
L @YTAC
OPAC (MOVM)
GENABS
FI
FI
SYSEXIT
SUBTTL PROCEDURE CHAR
CGSYI2:
edit(41)
SETLOW(X1) ;[41]
;Partly revised 75-10-06/Obj [41]
;GENERATE CODE FOR THE SYSTEM PROCEDURE CHAR
;ACCORDING TO THE FOLLOWING PATTERN:
; COMPVAL
; TDNN XTOP,[-1,,777600] ;[41]
; JRST .+5 ;[41]
; RTSERR QDSNIN,QCHARERROR [41]
; LOWADR ;[41]
; L XTOP,YDSIAR(XLOW) ;[41]
; JRST .-5 ;[41]
NEPHEW XP1,XP1
IF WHEN XP1,ZCN
GOTO FALSE
THEN
COMPVAL
HRROI 777600
GENWRD
OPAC (TDNN) ;[41]
GENREL
LI X3,QRELCD ;[41]
EXCH X3,YQRELR ;[41]
L X2,YRELCD ;Set up relocation constants [41]
LI 5(X2) ;[41]
OP (JRST) ;[41]
GENREL ;JRST .+5 [41]
L [RTSERR QDSNIN,QCHARERROR] ;[41]
GENABS ;Error UUO [41]
L [HRRZ XLOW,.JBOPS] ;[41]
GENABS ;LOWADR [41]
LI YDSIAR ;[41]
OPAC (L (XLOW)) ;[41]
GENABS ;L XTOP,YDSIAR(XLOW) [41]
LI -1(X2) ;[41]
OP (JRST) ;[41]
GENREL ;JRST .-5 [41]
EXCH X3,YQRELR ;[41]
ELSE
LF ,ZCNVAL(XP1)
TDNE [-1,,777600]
ERROR2 39,CHAR PARAMETER ERROR
OPAC (LI)
GENABS
FI
SYSEXIT
SETLOW(X1) ;[41]
SUBTTL PROCEDURE DIGIT
CGSYI3:
;GENERATE CODE FOR THE SYSTEM PROCEDURE DIGIT
;ACCORDING TO THE FOLLOWING PATTERN:
; COMPVAL
; CAIL XTOP,"0"
; CAILE XTOP,"9"
; TDZA XTOP,XTOP
; SETO XTOP,
NEPHEW XP1,XP1
COMPVAL
OPZAC (CAIL)
ADDI "0"
GENABS
OPZAC (CAILE)
ADDI "9"
GENABS
L @YTAC
OPAC (TDZA)
GENABS
OPZAC (SETO)
GENABS
SYSEXIT
SUBTTL PROCEDURE ENTIER
CGSYI4:
;GENERATE CODE FOR THE SYSTEM PROCEDURE ENTIER
;ACCORDING TO THE FOLLOWING PATTERN:
; COMPVAL
; FSBRI XTOP,0.5
; FIXR XTOP,XTOP
NEPHEW XP1,XP1
COMPVAL
OPZAC (FSBRI)
ADDI (0.5)
GENABS
L @YTAC
OPAC (FIXR)
GENABS
SYSEXIT
SUBTTL PROCEDURE LETTER
CGSYI5:
;GENERATE CODE FOR THE SYSTEM PROCEDURE LETTER
;ACCORDING TO THE FOLLOWING PATTERN:
; COMPVAL
; TRZ XTOP," "
; CAIL XTOP,"A"
; CAILE XTOP,"Z"
; TDZA XTOP,XTOP
; SETO XTOP,
NEPHEW XP1,XP1
COMPVAL
OPZAC (TRZ)
ADDI " "
GENABS
OPZAC (CAIL)
ADDI "A"
GENABS
OPZAC (CAILE)
ADDI "Z"
GENABS
L @YTAC
OPAC (TDZA)
GENABS
OPZAC (SETO)
GENABS
SYSEXIT
SUBTTL PROCEDURE MOD
CGSYI6:
;GENERATE CODE FOR THE SYSTEM PROCEDURE MOD
;ACCORDING TO THE FOLLOWING PATTERN:
;IF ARG2 NOT MEMOP
; COMPVAL ARG1 -> XTOP
; COMPVAL ARG2 -> XTOP+1
; IDIV XTOP,XTOP+1
; MOVE XTOP,XTOP+1
;
;IF ARG2 MEMOP AND NOT IMMOP
; COMPVAL ARG1
; IDIV XTOP,ARG2
; MOVE XTOP,XTOP+1
;
;IF ARG2 IMMOP
; COMPVAL ARG1
; IDIVI XTOP,ARG2
; MOVE XTOP,XTOP+1
GETAC2
L XL1,@YTAC
LSH XL1,5
BROTHER XP2,XP1
SON XP1,XP2
COMPVAL
NEPHEW XP1,XP2
AOS YTAC
IF MEMOP
GOTO FALSE
THEN
IF IMMOP
GOTO FALSE
THEN
LF ,ZCNVAL(XP1)
OPAC (IDIVI)
GENABS
ELSE
WHEN XP1,ZCN
GOTO L1
LF X1,ZIDZQU(XP1)
GETAD
OPZAC (IDIV)
SETZ X1,
DPB X1,[ACFIELD YO2ADI]
ST YOPCODE
GENOP
FI
ELSE
L1(): COMPVAL
L @YTAC
OPAC (IDIV)
GENABS
FI
L @YTAC
OPAC (MOVE)
GENABS
SOS YTAC
RELAC2
SYSEXIT
SUBTTL PROCEDURE RANK
CGSYI7:
;GENERATE CODE FOR THE SYSTEM PROCEDURE RANK
;ACCORDING TO THE FOLLOWING PATTERN:
; COMPVAL
NEPHEW XP1,XP1
COMPVAL
SYSEXIT
SUBTTL PROCEDURE SIGN
CGSYI8:
;GENERATE CODE FOR THE SYSTEM PROCEDURE SIGN
;ACCORDING TO THE FOLLOWING PATTERN:
; COMPVAL
; JUMPE XTOP,.+3
; ASH XTOP,-^D35
; IORI XTOP,1
;OPTIMIZE CONVERSION FROM INTEGER TO REAL
NEPHEW XP1,XP1
IF WHENNOT XP1,ZNS
GOTO FALSE
THEN
LF ,ZNSGEN(XP1)
IF CAIE %CONVE
GOTO FALSE
THEN
SON X1,XP1
LF ,ZIDTYP(X1)
CAIN QINTEGER
LI XP1,(X1)
FI
FI
COMPVAL
OPZAC (JUMPE)
ADDI 3
ADD YRELCD
GENRLD
OPZAC (ASH)
ADDI -^D35
GENABS
OPZAC (IORI)
ADDI 1
GENABS
SYSEXIT
SUBTTL PROCEDURE DETACH
CGSYI9:
;GENERATE CODE FOR THE SYSTEM PROCEDURE DETACH
;ACCORDING TO THE FOLLOWING PATTERN
; EXEC .CPDT
;CHECK THAT CURRENT BLOCK IS CLASS
L X1,YBKSTP
LOOP
POP X1,X2
LF X0,ZHETYP(X2)
AS
CAIN QFOR
GOTO TRUE
SA
CAIE QCLASB
ERROR2 37,DETACH NOT IN CLASS
GPUSHJ(CPDT)
CLEARM YLXIAC
SYSEXIT
SUBTTL PROCEDURE TIME(SIMULATION)
CGSYK1:
;GENERATE CODE FOR THE SYSTEM PROCEDURE TIME(SIMULATION)
;ACCORDING TO THE FOLLOWING PATTERN
; HLRZ XSAC,OFFSET(ZSUFT)(SIM.BLOCK ADDRESS)
; L XTOP,OFFSET(ZEVTIME)(XSAC)
GETCLASS
HRLZ @YTAC
ADD [HLRZ XSAC,OFFSET(ZSUFT)]
GENABS
OPZAC XSAC(L)
ADDI OFFSET(ZEVTIME)
GENABS
SYSEXIT
SUBTTL PROCEDURE LENGTH(FILE)
CGSYK2:
;GENERATE CODE FOR THE SYSTEM PROCEDURE LENGTH(FILE)
;ACCORDING TO THE FOLLOWING PATTERN
; LF XTOP,ZTVLNG(FILE ADDRESS,OFFSET(ZFIIMG))
GETCLASS
HRLZ @YTAC
ADD [LF ,ZTVLNG(,OFFSET(ZFIIMG))]
SETAC
GENABS
SYSEXIT
SUBTTL PROCEDURE MORE(FILE)
CGSYK3:
;GENERATE CODE FOR THE SYSTEM PROCEDURE MORE(FILE)
;ACCORDING TO THE FOLLOWING PATTERN
; L XSAC,OFFSET(ZFIIMG)+1(FILE ADDRESS)
; HLRZ X0,XSAC
; SETO XTOP,
; CAIG X0,(XSAC)
; SETZ XTOP,
GETCLASS
HRLZ @YTAC
ADD [L XSAC,OFFSET(ZFIIMG)+1]
GENABS
L [HLRZ XSAC]
GENABS
OPZAC (SETO)
GENABS
OPZ XSAC(CAIG)
GENABS
OPZAC (SETZ)
GENABS
SYSEXIT
SUBTTL PROCEDURE POS(FILE)
CGSYK4:
;GENERATE CODE FOR THE SYSTEM PROCEDURE POS(FILE)
;ACCORDING TO THE FOLLOWING PATTERN
; L XSAC,OFFSET(ZFIIMG)+1(FILE ADDRESS)
; LI XTOP,1(XSAC)
GETCLASS
HRLZ @YTAC
ADD [L XSAC,OFFSET(ZFIIMG)+1]
GENABS
OPZAC XSAC(LI)
ADDI 1
GENABS
SYSEXIT
SUBTTL PROCEDURE SETPOS(FILE)
CGSYK5:
;GENERATE CODE FOR THE SYSTEM PROCEDURE SETPOS(FILE)
;ACCORDING TO THE FOLLOWING PATTERN
; L XTOP,FILE ADDRESS
; L XTOP+2,ARG
; LI XTOP,OFFSET(ZFIIMG)(XTOP)
; EXEC .TXSE
GETCLASS
LI 2
ADDB YTAC
NEPHEW XP1,XP2
COMPVAL
HRREI -2
ADDB YTAC
HRLZ @X0
HRRI OFFSET(ZFIIMG)
OP (LI XWAC1,(XWAC1)) ; XTOP=XWAC1/SA
GENABS
GPUSHJ(TXSE)
SYSEXIT
SUBTTL PROCEDURE LOCATION(DIRECTFILE)
CGSYK6:
;GENERATE CODE FOR THE SYSTEM PROCEDURE LOCATION(DIRECTFILE)
;ACCORDING TO THE FOLLOWING PATTERN
; HRRZ XTOP,OFFSET(ZDFLOC)(FILE ADDRESS)
GETCLASS
OPAC (HRRZ)
TSO @YTAC
HRRI OFFSET(ZDFLOC)
GENABS
SYSEXIT
SUBTTL PROCEDURE SYSIN
CGSYK7:
;GENERATE CODE FOR THE SYSTEM PROCEDURE SYSIN
;ACCORDING TO THE FOLLOWING PATTERN
; LOWADR XSAC
; L XTOP,YSYSIN(XSAC)
L [LOWADR(XSAC)]
GENABS
LI YSYSIN
OPAC XSAC(L)
GENABS
SYSEXIT
SUBTTL PROCEDURE SYSOUT
CGSYK8:
;GENERATE CODE FOR THE SYSTEM PROCEDURE SYSOUT
;ACCORDING TO THE FOLLOWING PATTERN
; LOWADR XSAC
; L XTOP,YSYSOUT(XSAC)
L [LOWADR(XSAC)]
GENABS
LI YSYSOUT
OPAC XSAC(L)
GENABS
SYSEXIT
SUBTTL PROCEDURE LENGTH
CGSYK9:
;GENERATE CODE FOR THE SYSTEM PROCEDURE LENGTH
;ACCORDING TO THE FOLLOWING PATTERN
; LD XTOP,TEXT
; HLRZ XTOP,XTOP+1
GETTEXT
MOVS XL2
OPAC (HLRZ)
GENABS
RELAC2
SYSEXIT
SUBTTL PROCEDURE MORE
CGSYL1:
;GENERATE CODE FOR THE SYSTEM PROCEDURE MORE
;ACCORDING TO THE FOLLOWING PATTERN
; LD XTOP,TEXT
; HLRZ XTOP,XTOP+1
; CAIG XTOP,(XTOP+1)
;COMPVAL COMPCO COMPCC
; TDZA XTOP,XTOP SKIPA
; SETO XTOP,
GETTEXT
MOVS XL2
OPAC (HLRZ)
GENABS
OPZAC (CAIG)
ADD XL2
GENABS
IF IFOFF SVALUE
GOTO FALSE
THEN ; VALUE
L @YTAC
OPAC (TDZA)
GENABS
OPZAC (SETO)
GENABS
ELSE
IF IFOFF SCCOND
GOTO FALSE
THEN
SETOFF SCCOND
OPZ (SKIPA)
GENABS
FI
SETOFF SCONDI
SETON SVALUE
FI
RELAC2
SYSEXIT
SUBTTL PROCEDURE POS
CGSYL2:
;GENERATE CODE FOR THE SYSTEM PROCEDURE POS
;ACCORDING TO THE FOLLOWING PATTERN
; LD XTOP,TEXT
; LI XTOP,1(XTOP+1)
GETTEXT
LI 1
OPAC (LI)
ADD XL2
GENABS
RELAC2
SYSEXIT
SUBTTL PROCEDURE IDLE(PROCESS)
CGSYL3:
;GENERATE CODE FOR THE SYSTEM PROCEDURE IDLE(PROCESS)
;ACCORDING TO THE FOLLOWING PATTERN
; SKIPE OFFSET(ZPSZEV)(PROCESS ADDRESS)
; TDZA XTOP,XTOP
; SETO XTOP,
GETCLASS
HRLZ @YTAC
ADD [SKIPE OFFSET(ZPSZEV)]
GENABS
L @YTAC
OPAC (TDZA)
GENABS
OPZAC (SETO)
GENABS
SYSEXIT
SUBTTL PROCEDURE TERMINATED(PROCESS)
CGSYL4:
;GENERATE CODE FOR THE SYSTEM PROCEDURE TERMINATED(PROCESS)
;ACCORDING TO THE FOLLOWING PATTERN
; L X0,OFFSET(ZDNTER)(PROCESS ADDRESS)
; SETZ XTOP,
; TLNE X0,(1B<%ZDNTER>)
; SETO XTOP,
GETCLASS
HRLZ @YTAC
ADD [L OFFSET(ZDNTER)]
GENABS
OPZAC (SETZ)
GENABS
L [TLNE (1B<%ZDNTER>)]
GENABS
OPZAC (SETO)
GENABS
SYSEXIT
SUBTTL PROCEDURE CURRENT(SIMULATION)
CGSYL5:
;GENERATE CODE FOR THE SYSTEM PROCEDURE CURRENT(SIMULATION)
;ACCORDING TO THE FOLLOWING PATTERN
; HLRZ XSAC,OFFSET(ZSUFT)(SIM.BLOCK ADDRESS)
; HRRZ XTOP,OFFSET(ZEVZPS)(XSAC)
GETCLASS
HRLZ @YTAC
ADD [HLRZ XSAC,OFFSET(ZSUFT)]
GENABS
LI OFFSET(ZEVZPS)
OPAC XSAC(HRRZ)
GENABS
SYSEXIT
SUBTTL PROCEDURE ENDFILE(INFILE)
CGSYL6:
;GENERATE CODE FOR THE SYSTEM PROCEDURE ENDFILE(INFILE)
;ACCORDING TO THE FOLLOWING PATTERN
; L XTOP,OFFSET(ZDFEND)(FILE ADDRESS)
GETCLASS
OPAC (L)
TSO @YTAC
HRRI OFFSET(ZDFEND)
GENABS
ASSERT<
IFONA SCONDI
IFOFFA SCCOND
NOP
>
SYSEXIT
SUBTTL PROCEDURE LINE(PRINTFILE)
CGSYL7:
;GENERATE CODE FOR THE SYSTEM PROCEDURE LINE(PRINTFILE)
;ACCORDING TO THE FOLLOWING PATTERN
; HRRZ XTOP,OFFSET(ZPFLIN)(FILE ADDRESS)
GETCLASS
OPAC (HRRZ)
TSO @YTAC
HRRI OFFSET(ZPFLIN)
GENABS
SYSEXIT
SUBTTL PROCEDURE FIRST(HEAD)
CGSYL8:
;GENERATE CODE FOR THE SYSTEM PROCEDURE FIRST(HEAD)
;ACCORDING TO THE FOLLOWING PATTERN
; L XTOP,HEAD ADDRESS
; LF XTOP+1,ZLGSUC(XTOP)
; EXCH XTOP,XTOP+1
; CAMN XTOP,XTOP+1
; LI XTOP,NONE
GETCLASS
OPZAC
ADD [LF X1,ZLGSUC(X0)]
CGSYN1: TSO @YTAC ;COMMON PART OF FIRST AND LAST
HRRI OFFSET(ZLGSUC)
GENABS
OPZAC
HRR @YTAC
ADD [EXCH ,1]
GENABS
OPZAC
HRR @YTAC
ADD [CAMN ,1]
GENABS
LI NONE
OPAC (LI)
GENABS
SYSEXIT
SUBTTL FUNCTION LAST(HEAD)
CGSYL9:
; GENERATE CODE FOR THE SYSTEM FUNCTION LAST(HEAD)
; ACCORDING TO
; L XTOP,HEAD ADDRESS
; LF XTOP+1,ZLGPRE(XTOP)
; EXCH XTOP,XTOP+1
; CAMN XTOP,XTOP+1
; LI XTOP,NONE
GETCLASS
OPZAC
ADD [LF X1,ZLGPRE(X0)]
BRANCH CGSYN1 ; COMMON PART OF FIRST AND LAST
SUBTTL FUNCTION PREV(LINKAGE)
CGSYM1:
; GENERATE CODE FOR PREV ACCORDING TO
; L XTOP,HEAD ADDRESS
; LF XTOP,ZLGPRE(XTOP)
GETCLASS
OPZAC
ADD [LF X0,ZLGPRE(X0)]
TSO @YTAC
HRRI OFFSET(ZLGPRE)
GENABS
SYSEXIT
SUBTTL CLASS ATTRIBUTES
CGSYC:
LF X1,ZQUNAC(XV1)
XCT YGETAC(X1)
L XL1,YTAC
GETCLASS
IF edit(270) ;[270] I/O procedure (one extra ac)
IFOFF ZQUIO(XV1)
GOTO FALSE
THEN ;Reserve the extra ac, no relocation of second ac
AOS YTAC
HRRZS @YTAC ;Description of ac may be wrong
FI
AOS YTAC
GETREST
SUBTTL MATHEMATICAL SUBROUTINES
CGSYM:
;GENERATE CODE FOR THE PROCEDURE CALLS
;ACCORDING TO THE FOLLOWING PATTERN:
; COMPVAL
; [D]MOVEM XTOP,.YFARG
; MOVEI XFP,.YFADR
; PUSHJ XPDP,PROCEDURE
; [D]MOVE XTOP,0
LF XL2,ZIDTYP(XCUR)
NEPHEW XP1,XP1
IF ; CHECK IF LONG ARG TO MATH ROUT WITH ONLY SINGLE PRECISION
WHENNOT XP1,ZNS
GOTO FALSE
LF ,ZNSGEN(XP1)
CAIE %CONVE
GOTO FALSE ; NO CONVERSION OF ARG
LF X1,ZNSZNO(XP1) ; GET FROM TYPE IN CONV
LF ,ZNSTYP(X1)
CAIE QLREAL
GOTO FALSE ; NO WARNING IF INTEGER CONV.
THEN
LF X1,ZQULID(XV1)
SETZM YELIN2
ERRI1 QW,Q2.WAR+^D8
ASSERT<NOP [ASCIZ/ ID NOT IN DOUBLE PREC /]
>
FI
COMPVAL
SETZM YLXIAC
LI YFARG
OPAC (MOVEM)
CAIE XL2,QREAL
;***AUBEG
;DMOVEM IS UUO ON KA10, SO NO WARNING NEEDED
; KA10WARNING
; KA10WARNING
;***AUEND
OPAC (DMOVEM)
GENFIX
L [MOVEI XFP,YFADR]
GENFIX
LF ,ZQUIND(XV1)
OP (PUSHJ XPDP,)
CAIE XL2,QREAL
ADDI 1
GENFIX
OPZAC (MOVE)
CAIE XL2,QREAL
OPZAC (DMOVE)
GENABS
SYSEXIT
SUBTTL MISC.PROCEDURES
CGSYP:
LF X1,ZQUNAC(XV1)
XCT YGETAC(X1)
L XL1,YTAC
L XP2,XP1
GETREST
SUBTTL TEXT ATTRIBUTES
CGSYT:
SON XP2,XCUR
SON XP1,XP2
LF X1,ZQUNAC(XV1)
XCT YGETAC(X1)
L XL1,YTAC
IF IFON ZQUIO(XV1)
GOTO FALSE
THEN ;SUB,STRIP OR MAIN
COMPVAL
LI 2
ADDM YTAC
GETREST
ELSE
COMPAD
LI 2
ADDM YTAC
GETPARM
L X1,XL1
HRRZ (X1)
MAKEAD
GETTREST
FI
SUBTTL CGSYS1
;THIS PROCEDURE IS ENTERED THRU THE OPDEF GETPARM
CGSYS1:
PROC
WHILE
IFON ZNOLST(XP2)
GOTO FALSE
DO
BROTHER XP2,XP2
SON XP1,XP2
IF
LF ,ZIDMOD(XP1,2)
CAIE QREFER
GOTO FALSE
LF ,ZIDKND(XP1,2)
CAIE QSIMPLE
GOTO FALSE
LF ,ZIDTYP(XP1,2)
CAILE QTEXT
GOTO FALSE
THEN
COMPAA
ASSERT<
L 2(XP1)
IFONA ZNOLST(X0)
NOP
>
ELSE
COMPVAL
LF ,ZIDTYP(XP1)
CAIE QTEXT
CAIN QLREAL
AOS YTAC
FI
AOS YTAC
OD
RETURN
EPROC
SUBTTL CGSYS2
;THIS ROUTINE IS ENTERED THRU THE OPDEF GETREST
CGSYS2:
GETPARM
CGSYS3: ST XL1,YTAC
CLEARM YLXIAC
IF IFON ZQUPR(XV1)
GOTO FALSE
IFON ZQUGB(XV1)
GOTO FALSE ; XTOP IS GIVEN BY AC DESCRIPTOR
THEN
L @YTAC
OP (LI XTAC,)
GENABS
FI
LF ,ZQUIND(XV1)
OP (PUSHJ XPDP,)
IF TRNN 400K
GOTO FALSE
THEN
GENABS
ELSE
GENFIX
FI
IFON ZQUGB(XV1)
ACSMAP
LF X1,ZQUNAC(XV1)
XCT YRELAC(X1)
SYSEXIT
LIT
END