Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/13/orrk.mac
There are 2 other files named orrk.mac in the archive. Click here to see a list.
COMMENT;
AUTHOR: REIDAR KARLSON
UPDATED AT ACADIA UNIVERSITY FOR KA10
VERSION: 3A [5,12,35,40,133,134,174]
CONTENTS: ORBU,ORCC,ORCT,ORDT,ORLU,ORLD,ORRP,ORSM,ORTY
;
SEARCH SIMMCR,SIMMAC,SIMMC2,simrpa
CTITLE ORRK
INTERNAL ORBU,ORCC,ORCT,ORDT,ORLU,ORLD,ORRP,ORSM,ORTY
INTERNAL ORTXCH ;[174]
EXTERNAL ORCN,ORMV
EXTERNAL O2GA,O2AB
EXTERNAL YDICTB,YEXPP,YFOP,YMAXID,YNOPD,YNZCN,YNZID,YNZNS,YSTKNU
EXTERNAL YGAP
EXTERNAL YORPAR,YOPSTB,YOPSTP,YSTEPP,YUNDEC,YDCSTB,YDCSTP
EXTERNAL YTEXTI
EXTERNAL YZHET
QTYPM= 17B<%ZIDTYP+^D18>
QKNDM= 7B<%ZIDKND+^D18>
SALL
OPDEF GENABS [PUSHJ XPDP,O2GA]
TWOSEG
RELOC 400000
MACINIT
SUBTTL ORBU
COMMENT;
PURPOSE: TO DETERMINE THE ZNSROR,ZNSSEF AND ZNSLEV FIELDS OF A
NODE.
ENTRY: ORBU
INPUT ARGUMENTS: THE OPERATOR NODE IS COMPLETE IN XV1 AND XV2
EXCEPT THE THREE FIELDS MENTIONED ABOVE
NORMAL EXIT: RETURN
ERROR EXIT: NONE
OUTPUT ARGUMENTS: NONE
CALL FORMAT: EXEC ORBU
USED SUBROUTINE: ORBUSE
;
; SUBROUTINE ORBUSE
; CALLED WHEN A ZID OPERAND CAUSES SIDE EFFECTS
; ZNSSEF WILL BE SET IN THE OPERAND NODE XV1-XV2 AND X3 WILL BE UPDATED
; TO THE MAXIMUM SOURCE LEVEL
ORBUSE: PROC
SETONA ZNSSEF(XV2)
LF X1,ZIDZQU(X2)
LF X1,ZQUZHE(X1)
LF X1,ZHESOL(X1)
CAIGE X3,(X1)
L X3,X1
RETURN
EPROC
ORBU: PROC
L X2,YSTEPP
SETOFA ZNSSEF(XV2)
IF
HLR X0,(X2)
CAIE X0,-1
GOTO FALSE
THEN
;ONE OPERAND ONLY
SETONA ZNSROR(XV2)
IF
RECTYPE(X2) IS ZNS
GOTO FALSE
THEN
;COPY ZNSSEF AND -LEV
IFON ZNSSEF(X2)
SETONA ZNSSEF(XV2)
LF X0,ZNSLEV(X2)
SF X0,ZNSLEV(,XV1)
RETURN
FI
IF
RECTYPE(X2) IS ZID
GOTO FALSE
THEN
;FOR ZID WITH MODE QNAME OR (KIND QCLASS AND
; ZNSGEN IN XV1-2 IS %NEW) ZNSSEF IS SET AND
; ZNSLEV IS SET TO ZIDZQU.ZQUZHE.ZHESOL
IF
IFEQF X2,ZIDMOD,QNAME
GOTO TRUE
IFNEQF X2,ZIDKND,QCLASS
GOTO FALSE
LF X0,ZNSGEN(,XV1)
CAIE X0,%NEW
GOTO FALSE
THEN
EXEC ORBUSE
SF X3,ZNSLEV(,XV1)
FI
RETURN
FI
ASSERT< WHENNOT X2,ZCN
RFAIL WRONG OPERAND NODE TYPE IN ORBU
>
RETURN
FI
;MORE THAN ONE OPERAND
SAVE <X4,X5>
SETZB X3,X4
SETZ X5,
;THE OPERAND NODES ARE TESTED IF THEY CAUSE SIDE EFFECTS
LOOP
IF ;ZID NODE?
RECTYPE(X2) IS ZID
GOTO FALSE
THEN
IF ;MODE QNAME?
IFNEQF (X2,ZIDMOD,QNAME)
GOTO FALSE
THEN
AOS X4
EXEC ORBUSE
FI
ELSE
IF ;ZNS NODE?
RECTYPE(X2) IS ZNS
GOTO FALSE
THEN
IF ;ITS ZNSSEF IS SET?
IFOFF ZNSSEF(X2)
GOTO FALSE
THEN ;SET ZNSSEF IN THE OPERAND NODE IN XV1-2
; COUNT THE NUMBER OF ZNS NODES CAUSING
; SIDE EFFECTS IN X5
; UPPDATE X3 TO THE MAXIMUM SOURCE LEVEL
SETONA ZNSSEF(XV2)
AOS X5
LF X1,ZNSLEV(X2)
CAIGE X3,(X1)
L X3,X1
FI
ELSE
ASSERT< WHENNOT X2,ZCN
RFAIL WRONG OPERAND NODE TYPES IN ORBU
>
;ONLY ZCN,ZID AND ZNS NODES SHOULD OCCUR
FI
FI
AS
STEPJ (X2,ZID,TRUE)
SA
;DETERMINE IF ZNSROR SHOULD BE SET
SF X3,ZNSLEV(,XV1) ;ZNSLEV = MAX LEVEL
SETOFA ZNSROR(XV2)
ADD X4,X5 ;X4 = NUMBER OF ZID WITH MODE
; QNAME AND ZNS WITH ZNSSEF SET
IF
JUMPE X4,TRUE ;NO OPERAND CAUSES SIDE EFFECTS
L X1,YNOPD
SUB X1,YNZCN ;X1 = NUMBER OF OPERANDS
; THAT ARE NOT ZCN
CAIE X1,1 ;ALL BUT ONE ARE ZCN OPERANDS
GOTO FALSE
THEN
SETONA ZNSROR(XV2) ;SWAPPING ALLOWED
ELSE
IF
CAIE X4,1
GOTO FALSE ;MORE THAN ONE ZNS WITH ZNSSEF SET OR
; ZID WITH MODE QNAME
CAME X5,YNZNS
GOTO FALSE ;ANOTHER ZNS OPERAND PRESENT
THEN
IF ;ADDITIONAL ZID OPERANDS?
SUB X4,X5
CAMN X4,YNZID
GOTO FALSE
THEN ;DETERMINE MINIMUM LEVEL OF ALL ZID
; OPERANDS THAT ARE NOT OF MODE QNAME
L X2,YSTEPP
LI X4,100
LOOP
IF
RECTYPE(X2) IS ZID
GOTO FALSE
IFEQF (X2,ZIDMOD,QNAME)
GOTO FALSE
THEN
LF X1,ZIDZQU(X2)
LF X1,ZQUZHE(X1)
LF X1,ZHESOL(X1)
CAILE X4,(X1) ;MIN LEVEL IN X4
L X4,X1
FI
AS
STEPJ (X2,ZID,TRUE)
SA
IF
CAIL X3,(X4)
GOTO FALSE ;THE OPERAND CAUSES SIDE EFFECTS
; AT A LEVEL THAT IS NOT LOWER
; THAN THE MINIMUM LEVEL OF
; ALL OTHER ZID OPERANDS
THEN
SETONA ZNSROR(XV2)
FI
ELSE
SETONA ZNSROR(XV2)
FI
FI
FI
RETURN
EPROC
SUBTTL ORCC
COMMENT;
PURPOSE: TO CHECK COMPATIBILITY OF OPERAND TYPES AND
TO CONVERT OPERANDS.
ENTRY: ORCC
INPUT ARGUMENTS: AN INDEX IS PASSED AS PARAMETER IN XP1
INDICATING THE OPERAND TYPE CORRESPONDENCE.
THE FOLLOWING CASES OCCUR:
XP1 ACTION
------------------------------------------------
QCSAME CHECK TYPE AND QUAL. COMPATIBILITY
QCLEFT CONVERT TO TYPE OF FIRST OPERAND
IF REF CONVERT TO QUAL. OF FIRST OPERAND
QCHIGH CONVERT TO HIGHEST TYPE
QCREAL CONVERT TO REAL OR LONG REAL
QCINT CONVERT TO INTEGER
NORMAL EXIT: RETURN
ERROR EXIT: RETURN
OUTPUT ARGUMENTS: NONE
CALL FORMAT: EXEC ORCC
USED SUBROUTINE: ORCN, ORCT
;
ORCC: PROC
L XL1,YSTEPP
ASSERT< CAILE XP1,QCINT
RFAIL WRONG XP1 IN ORCC
>
XCT [RETURN
GOTO ORCCSA
GOTO ORCCLE
GOTO ORCCHI
GOTO ORCCRE
GOTO ORCCIN](XP1) ;LITERAL INDEXED BY XP1
ORCCSA: ;QCSAME
; CHECK IF THE OPERANDS HAVE THE SAME TYPE OR TYPE QUNDEF
; IF THE TYPE IS QREF THEN CHECK IF THEIR QUALIFICATIONS ARE
; COMPATIBLE, I.E. THEY ARE EQUAL OR ONE IS NONE OR ONE IS A SUBCLASS
; OF THE OTHER
LF X0,ZIDTYP(XL1)
LF X2,ZIDTYP(XL1,ZID%S)
IF
CAIN X0,(X2)
GOTO FALSE
CAIE X2,QUNDEF
CAIN X0,QUNDEF
GOTO FALSE
THEN
ERROR1 23,XCUR,INCOMPATIBLE TYPES OF OPERATOR (%OPT)
SETZ
SF ,ZIDTYP(XL1)
RETURN
FI
CAIE X0,QREF
RETURN ;NOT TYPE REF
WHEN XL1,ZCN
RETURN ;FIRST OPERAND NONE
LF X1,ZIDZDE(XL1)
SSTEP (XL1,ZID)
WHEN XL1,ZCN
RETURN ;SECOND OPERAND NONE
LF X2,ZIDZDE(XL1)
IF
JUMPE X1,TRUE
JUMPN X2,FALSE
THEN
RETURN ;ONE HAS QUAL. ZERO
FI
LF X1,ZQUZB(X1)
LF X2,ZQUZB(X2)
CAIN X1,(X2)
RETURN ;SAME QUAL.
L X0,X1
LOOP
LF X3,ZHBZHB(X1)
CAIN X3,(X2)
RETURN ;SUBCLASS
L X1,X3
AS
JUMPN X1,TRUE
SA
LOOP
LF X3,ZHBZHB(X2)
CAIN X0,(X3)
RETURN ;SUBCLASS
L X2,X3
AS
JUMPN X2,TRUE
SA
ORCCER: L XL1,YSTEPP
LF X1,ZIDZDE(XL1)
LF X1,ZQULID(X1)
STEP XL1,ZID
LF X2,ZIDZDE(XL1)
LF X2,ZQULID(X2)
L X3,XCUR
ERRI3 QE,<Q2.ERR+^D27>
ASSERT<
NOP [ASCIZ/ INCOMPATIBLE QUALIFICATIONS (%ID AND %ID) OF OPERATOR (%OPT)/]
>
RETURN
ORCCLE: ;QCLEFT
; ALL OPERANDS ARE CONVERTED TO THE TYPE AND QUALIFICATION OF THE
; FIRST OPERAND BY CALLING ORCN
L XP1,XL1
SSTEP (XL1,ZID)
LOOP
LF X0,ZIDTYP(XP1)
LF X1,ZIDZDE(XP1)
EXEC ORCN ;CONV TO LEFT TYPE
AS
STEPJ (XL1,ZID,TRUE)
SA
RETURN
ORCCHI: ;QCHIGH
; ALL OPERANDS ARE CONVERTED TO THE HIGHEST TYPE CODE OCCURING
; AMONG THE OPERANDS.
LF X0,ZIDTYP(XL1)
LF X2,ZIDTYP(XL1,ZID%S)
IF
CAIGE X0,(X2)
GOTO FALSE
THEN
IF
CAIE X0,(X2)
GOTO FALSE
CAIN X0,QREF
CAIE XCUR,%IFEX
RETURN
THEN
;ELSE OPERANDS
; TRY TO FIND THE INNERMOST CLASS WHICH
; INCLUDES THE QUAL. OF BOTH OPERANDS
; AND GIVE AN ERROR MESSAGE IF NO SUCH
; CLASS IS FOUND
LF X1,ZIDZDE(XL1)
IF
JUMPN X1,FALSE
THEN
;FIRST OPERAND HAS QUAL. ZERO (I.E. NONE)
LF X1,ZIDZDE(XL1,ZID%S)
SF X1,ZIDZDE(XL1) ;SET QUAL. OF FIRST OPERAND TO
; QUAL. OF SECOND OPERAND
RETURN
FI
LF X2,ZIDZDE(XL1,ZID%S)
SKIPN X2
RETURN ;SECOND OPERAND NONE
LF X1,ZQUZB(X1)
LF X2,ZQUZB(X2)
CAMN X2,X1
RETURN ; IF QUALIFS EQUAL
LF X3,ZHBZHB(X1)
SKIPN X3
EXCH X1,X2 ;NO PREFIX TO X1
LOOP
LF X1,ZHBZHB(X1)
JUMPE X1,ORCCER
L X3,X2
LOOP
IF
CAME X1,X3
GOTO FALSE
THEN
;SET QUAL. OF THE FIRST OPERAND
; TO THE CLASS FOUND
LF X1,ZHBZQU(X1)
SF X1,ZIDZDE(XL1)
RETURN
FI
LF X3,ZHBZHB(X3)
AS
JUMPN X3,TRUE
SA
AS
GOTO TRUE
SA
FI
LF X1,ZIDZDE(XL1)
SSTEP XL1,ZID
EXEC ORCN ;CONVERT SECOND OPERAND
ELSE
L X0,X2
LF X1,ZIDZDE(XL1,ZID%S)
EXEC ORCN ;CONVERT FIRST OPERAND
FI
RETURN
ORCCRE: ;QCREAL
;[5] THE CHECK FOR %POW IS CHANGED
; IF XCUR = %POW AND SECOND OPERAND IS AN INTEGER CONSTANT IN [0,34]
; THEN CHECK IF FIRST OPERAND IS THE INTEGER CONST 2.
; IF SO 2^CONST WILL BE EVALUATED AT COMPILE TIME AS AN INTEGER
; CONSTANT. IN ALL OTHER CASES WITH INTEGERS AS SECOND OPERAND
; CHECK IF FIRST OPERAND IS AN INTEGER AND IF SO CONVERT FIRST
; OPERAND TO REAL AND GIVE A WARNING MESSAGE.
; STANDARD PROCESSING IS TO CONVERT ALL OPERANDS TO REAL, OR IF
; ANY OPERAND OF TYPE LONG REAL IS PRESENT, TO LONG REAL.
IF
CAIE XCUR,%POW
GOTO FALSE
SSTEP (XL1,ZID)
IFNEQF (XL1,ZCNTYP,QINTEGER)
GOTO FALSE
THEN
;[5] THE CHECK FOR %POW WITH INTEGER AS SECOND OP IS CHANGED
IF
RECTYPE(XL1) IS ZCN
GOTO FALSE
LF X1,ZCNVAL(XL1)
JUMPL X1,FALSE
CAIL X1,^D35
GOTO FALSE
L XL1,YSTEPP
IFNEQF (XL1,ZCNTYP,QINTEGER)
GOTO FALSE
RECTYPE (XL1) IS ZCN
GOTO FALSE
LF X1,ZCNVAL(XL1) ;[12] NOT ZCNTYP
CAIE X1,2
GOTO FALSE
THEN
;SECOND OPERAND IS CONST IN [0,34]
; AND FIRST OP IS = INT CONST = 2
; NO ACTION HERE JUST RETURN
; 2^CONST WILL BE EVALUATED AT .POW
ELSE
L XL1,YSTEPP
IF
IFNEQF XL1,ZCNTYP,QINTEGER
GOTO FALSE
THEN ;FIRST OP IS INTEGER CONVERT IT TO REAL
; AND GIVE A WARNING FOR THIS CONVERSION
LI X0,QREAL
EXEC ORCN
WARNING 4,INTEGER BASE CONVERTED TO REAL BEFORE EXPONENTIATION
FI
FI
RETURN
FI
L XL1,YSTEPP
LI XP1,QREAL
LOOP
LF X1,ZIDTYP(XL1)
AS
CAIN X1,QLREAL ;IF ANY OPERAND HAS TYPE
AOJA XP1,FALSE ;LONGREAL THEN XP1=QREAL+1
STEPJ (XL1,ZID,TRUE) ;ELSE XP1=QREAL
SA
L XL1,YSTEPP
LOOP
L X0,XP1
EXEC ORCN ;CONVERT TO REAL OR LREAL
AS
STEPJ (XL1,ZID,TRUE)
SA
RETURN
ORCCIN: ;QCINT
; ALL OPERANDS ARE CONVERTED TO TYPE QINTEGER
LOOP
LI X0,QINTEGER
EXEC ORCN ;CONVERT TO INTEGER
AS
STEPJ (XL1,ZID,TRUE)
SA
RETURN
EPROC
SUBTTL ORCT
COMMENT;
PURPOSE: CHECK THE TYPE OF THE FIRST OPERAND ACCORDING
TO A CODE IN XP1.
ENTRY: ORCT
INPUT ARGUMENTS: A CHECK CODE IN XP1 AS FOLLOWS
XP1 CHECK ACTION
-----------------------------------------------
1-9 TYPE = CODE IN XP1
QARITH ARITHMETIC TYPE ( <= QLREAL )
QTXREF TYPE = QTEXT OR QREF
QNREF TYPE \= (QREF OR QLABEL)
QNRFBO TYPE \= (QREF OR QBOOLEAN OR QLABEL)
NORMAL EXIT: RETURN
ERROR EXIT: RETURN
OUTPUT ARGUMENTS: NONE
CALL FORMAT: EXEC ORCT
;
ORCT: PROC
L X1,YFOP
LF X0,ZIDTYP(X1)
ASSERT< CAILE XP1,QNRFBO
RFAIL WRONG XP1 IN ORCT
>
CAIGE XP1,QARITH
GOTO ORCTTY
SUBI XP1,QARITH
XCT [GOTO ORCTAR
GOTO ORCTTR
GOTO ORCTNR
GOTO ORCTN](XP1) ;LITERAL INDEXED BY XP1
ORCTTY: ;CODE 1-9
; CHECK IF FIRST OPERAND (FOP) HAS THE SAME TYPE CODE AS THE CODE
; IN XP1
CAIN X0,(XP1)
RETURN
GOTO ORCTER
ORCTAR: ;QARITH
; CHECK IF FOP HAS A TYPE CODE THAT IS <= QLREAL
CAIG X0,QLREAL
RETURN
GOTO ORCTER
ORCTTR: ;QTXREF
; CHECK IF FOP HAS TYPE QTEXT OR QREF
CAIN X0,QTEXT
RETURN
CAIN X0,QREF
RETURN
GOTO ORCTER
ORCTN: ;QNRFBO
; CHECK IF FOP HAS NOT TYPE QREF, QBOOLEAN OR QLABEL
CAIN X0,QBOOLEAN
GOTO ORCTER
;CONTINUE TO ORCTNR
ORCTNR: ;QNREF
; CHECK IF FOP HAS NOT TYPE QREF OR QLABEL
CAIN X0,QREF
GOTO ORCTER
CAIN X0,QLABEL
GOTO ORCTER
RETURN
ORCTER: SKIPE ;ACCEPT UNDEFINED
ERROR1 24,XCUR, INVALID OPERAND TYPE OF OPERATOR (%OPT)
RETURN
EPROC
SUBTTL ORDT
COMMENT;
PURPOSE: TO PROCESS A DOT OPERAND
ENTRY: ORDT
INPUT ARGUMENTS: NONE
NORMAL EXIT: BRANCH ORMV
ERROR EXIT: RETURN
OUTPUT ARGUMENTS: NONE
CALL FORMAT: EXEC ORDT
USED SUBROUTINES: ORBU, ORCT, ORLD, ORLU, ORMV, ORSM
;
ORDT: PROC
HRRZ XP1,YOPSTP ;SET YFOP AND YSTEPP
SUBI XP1,3
ASSERT< CAMGE XP1,YOPSTB
RFAIL (STACK UNDERFLOW IN ORDT)>
ST XP1,YFOP
HRLI XP1,-3 ; -3 ,, YOPSTP-3
ST XP1,YSTEPP
IF ;[174]
LI X0,(XP1)
EXEC ORTXCH
GOTO FALSE
THEN
ERROR2 46,CONSTANT BEFORE DOT
FI
WHEN XP1,ZLI
EXEC ORLU ;LOOK UP FIRST OPERAND
EXEC ORSM ;CHECK KIND SIMPLE
LI XP1,QTXREF
EXEC ORCT ;CHECK TYPE REF OR TEXT
L XP1,YFOP
LF ,ZNSTYP(XP1)
L X1,YTEXTI
CAIN QTEXT
SF X1,ZNSZQU(XP1)
LF X1,ZNSZQU(XP1)
STEP XP1,ZID
IF
JUMPE X1,TRUE
cain x1,yundec
goto true
JUMPE X0,TRUE
CAIE QTEXT
CAIN QREF
SKIPA ; REF OR TEXT
GOTO TRUE ; NOT TEXT OR REF
WHEN XP1,ZLI
GOTO FALSE
THEN
;UNDEFINED FIRST OR SECOND OPERAND
L1(): LI X1,YUNDEC
EXEC ORLD
SETF QZNS,ZNOTYP(,XV1)
SETF %DOT,ZNSGEN(,XV1)
BRANCH ORMV
FI
L XP1,YFOP
;GIVE AN ERRORMESSAGE IF THE
; QUALIFYING CLASS HAS ITS
; ZHBKDP SET
LF X4,ZIDZDE(XP1)
LF X2,ZQUZB(X4)
IF
IFOFF ZHBKDP(X2)
GOTO FALSE
THEN
LF X2,ZQULID(X4)
ERROR1 25, X2, INVALID REMOTE ACCESS CLASS (%ID) HAS LOCAL CLASS ATTR.
STEP XP1,ZID
GOTO L1
FI
;SEARCH IN THE ATTRIBUTE LISTS OF THE QUALIFYING CLASS AND ITS PREFIXES
; FOR THE ID-NUMBER OF THE SECOND OPERAND AND TRANSFORM THIS OPERAND
; TO A ZID NODE BY CALLING ORLD. MOVE THE OPERANDS INTO THE TREE AND
; REPLACE THEM WITH A ZNS NODE WITH ZNSGEN = %DOT IN THE OPERAND STACK
STEP XP1,ZID
LF X3,ZLILID(XP1)
LOOP
STEP (X2,ZHB,X1)
WHILE ;ZQU RECORD
RECTYPE(X1) IS ZQU
GOTO FALSE
DO
LF X0,ZQULID(X1)
IF
CAIE X0,(X3)
GOTO FALSE
IFON ZQUIVA(X1) ;[40]
GOTO FALSE
THEN
EXEC ORLD ;TRANSFORM SECOND OPERAND
LF ,ZQUTYP(X1)
CAIN QLABEL
ERROR1 24,XCUR, INVALID LABEL TYPE OPERAND OF DOT
SETF (%DOT) ZNSGEN(,XV1)
SETF (QZNS) ZNOTYP(,XV1)
EXEC ORBU ;SET ZNS-SEF,-LEV,-ROR
BRANCH ORMV ;PLACE OPERANDS IN TREE
FI
STEP (X1,ZQU)
OD
LF X2,ZHBZHB(X2) ;GET PREFIX
AS
WHEN (X2,ZHB)
GOTO TRUE
SA
L X1,X3
LF X2,ZQULID(X4)
ERRI2 QE,<Q2.ERR+^D41>
ASSERT<
NOP [ASCIZ/ INVALID REMOTE ACCESS (%ID) IS NOT AN ATTRIBUTE OF (%ID)/]
>
GOTO L1
EPROC
SUBTTL ORLU
COMMENT;
PURPOSE: TO LOOK UP AN IDENTIFIER IN THE DICTIONARY AND TRANSFORM
A ZLI NODE TO A ZID NODE IN THE OPERAND STACK.
ENTRY: ORLU
INPUT ARGUMENTS: THE ZLI NODE ADDRESS IS PASSED IN XP1
NORMAL EXIT: BRANCH ORLD
ERROR EXIT: NONE
CALL FORMAT: EXEC ORLU
USED SUBROUTINE: ORLD
;
ORLU: PROC
ASSERT< ;VERIFY THAT THE NODE AT XP1 IS A ZLI NODE
WHENNOT (XP1,ZLI)
RFAIL (NOT ZLI NODE AT XP1 WHEN CALLING ORLU)>
LF X2,ZLILID(XP1)
ASSERT< ;TEST ID-NO IN RANGE
CAIL X2,QLOWID
CAMLE X2,YMAXID
RFAIL (ID-NO NOT IN RANGE FOUND IN ORLU)>
;IF THE ZDCZQU IN THE DICTIONARY ENTRY IS ZERO THEN GIVE AN ERROR
; MESSAGE AND INSERT A POINTER TO A DUMMY ZQU RECORD AND PROCEED
ADDI X2,YDICTB
LF X1,ZDCZQU(X2)
IF
JUMPN X1,FALSE
THEN
LI X1,YUNDEC
SF X1,ZDCZQU(X2)
SUBI X2,YDICTB
ERROR1 26, X2, IDENTIFIER (%ID) IS NOT DECLARED
FI
BRANCH ORLD
EPROC
SUBTTL ORLD
COMMENT;
PURPOSE: TO TRANSFORM A ZLI NODE TO A ZID NODE IN THE
OPERAND STACK BY MEANS OF A SUPPLIED ZQU POINTER IN X1
ENTRY: ORLD
INPUT ARGUMENTS: A ZQU POINTER IN X1
AND THE ZLI NODE ADDRESS IN XP1
NORMAL EXIT: RETURN
ERROR EXIT: NONE
CALL FORMAT: EXEC ORLD
;
ORLD: PROC
ASSERT< ;VERIFY THAT THE NODE AT XP1 IS A ZLI NODE
IF CAIN X1,YUNDEC
GOTO FALSE
THEN
WHENNOT (XP1,ZLI)
RFAIL (NOT ZLI NODE AT XP1 WHEN CALLING ORLD)
;TEST THAT X1 POINTS TO A ZQU RECORD IN THE DEC. STACK
WHENNOT (X1,ZQU)
RFAIL (X1 DOES NOT POINT TO A ZQU RECORD WHEN CALLING ORLD)
CAMLE X1,YDCSTB
CAML X1,YDCSTP
RFAIL (X1 POINTS OUT OF THE DECLARATION STACK IN ORLD)
FI
>
;BUILD UP A ZID RECORD IN XV1-XV2 AND LET IT REPLACE THE ZLI RECORD
; AT XP1.
WLF XV1,ZQUZHE(X1)
WLF XV2,ZQUZB(X1)
SF X1,ZIDZQU(,XV1)
SETF QZID,ZNOTYP(,XV1)
TLZ XV1,(1B<%ZNOLST>) ; SETOFF ZNOLST
TLO XV1,(1B<%ZNOTER>) ; SETON ZNOTER
STD XV1,(XP1)
CAIE X1,YUNDEC
RETURN
SETON SCERFL
RETURN
EPROC
SUBTTL ORRP
COMMENT;
PURPOSE: TO PROCESS A %RP (RIGHT PARENTHESIS) OPERATOR
ENTRY: ORRP
INPUT ARGUMENTS: A POINTER TO THE LAST OCCUPIED WORD IN THE
OPERAND STACK (YOPSTP) AND A POINTER TO THE
FIRST OCCUPIED WORD IN THE TREE (YEXPP)
NORMAL EXIT: BRANCH ORMV
ERROR EXIT: NONE
CALL FORMAT: EXEC ORRP
USED SUBROUTINES: LOCAL: ORRPPP, ORRPER
GLOBAL: ORLU, ORCN, ORSM, ORMV, ORBU
;
ORRPER:
;CHECK IF FORMAL OR ACTUAL PARAM. HAS KIND OR TYPE QUNDEF
IF
L X0,(XL1)
TLNE X0,QTYPM
TLNN X0,QKNDM
GOTO FALSE
L X0,(XP1)
TLNE X0,QTYPM
TLNN X0,QKNDM
GOTO FALSE
THEN
ELSE
UNSTK ;FORGET RETURN ADDRESS
GOTO ORRPOK
FI
;LOAD X1 AND X2 WITH LEXICAL ID OF FORMAL PARAMETER
; AND PARENT NODE RESPECTIVELY
LF X1,ZQULID(XP1)
LF X2,ZIDZQU(XP2)
LF X2,ZQULID(X2)
RETURN
SUBTTL ORRPPP
COMMENT;
PURPOSE: TO PROCESS ACTUAL-FORMAL PARAMETER PAIRS
ENTRY: ORRPPP
INPUT ARGUMENTS: XP1 POINTS TO THE FORMAL PARAMETER
LIST HEADER (ZHB)
XL1 POINTS TO THE ACTUAL PARAMETER IN THE
OPERAND STACK
NORMAL EXIT: RETURN
ERROR EXIT: NONE
CALL FORMAT: EXEC ORRPPP
USED SUBROUTINES: ORSM, ORCN, ORRPER
;
ORRPPP: PROC
;THE COMPATIBILITY OF FORMAL AND ACTUAL PARAMETERS IS CHECKED
; TO CONNECT THE ACTUAL PARAMETER TO ITS CORRESPONDING FORMAL PARAMETER
; THE ZID NODES OF BOTH PARAMETERS ARE PLACED IN THE TREE
; AND THE ACTUAL PARAMETER IN THE OPERAND STACK ARE REPLACED BY A ZNS
; NODE WITH ZNSGEN = %PARM
STEP (XP1,ZHB)
WHILE ;ZQU OF MODE QVALUE, QNAME OR QREFER AT XP1
RECTYPE(XP1) IS ZQU
GOTO FALSE
LF ,ZQUMOD(XP1) ;[40]
JUMPE FALSE
CAILE QREFER
GOTO FALSE
DO ;CHECK PARAMETER COMPATIBILITY
; XP1 POINTS TO THE FORMAL PARAMETER ZQU NODE AND
; XL1 " " " ACTUAL " NODE IN THE OPERAND STACK
;CHECK IF TYPE AND KIND EQUAL
L2(): L X0,(XP1)
XOR X0,(XL1)
IF
TLNE X0,QTYPM+QKNDM
GOTO FALSE
THEN
LF X1,ZIDTYP(XL1)
IF ;TYPE = QREF
CAIE X1,QREF
GOTO FALSE
THEN
IF ;IF FORMAL PARAMETER HAS MODE QREFER THEN THE
; QUALIFICATION OF THE ACTUAL PARAMETER IS
; CHECKED BY ORCN, ELSE THE QUALIFICATIONS MUST
; BE COMPATIBLE (THE SAME TEST AS IN ORCC QCSAME)
IFNEQF (XP1,ZQUMOD,QREFER)
GOTO FALSE
THEN
LI X0,QREF
LF X1,ZQUZQU(XP1)
EXEC ORCN
ELSE
LF X1,ZIDZDE(XL1)
LF X2,ZQUZQU(XP1)
JUMPE X1,ORRPOK
JUMPE X2,ORRPOK ;ONE HAS QUAL ZERO
LF X1,ZQUZB(X1)
LF X1,ZHBZQU(X1)
LF X2,ZQUZB(X2)
LF X2,ZHBZQU(X2)
CAIN X1,(X2)
GOTO ORRPOK ;SAME QUAL
LF X1,ZQUZB(X1)
LF X2,ZQUZB(X2)
L X0,X1
LOOP
LF X3,ZHBZHB(X1)
CAIN X3,(X2)
GOTO ORRPOK ;SUBCLASS
L X1,X3
AS
JUMPN X1,TRUE
SA
LOOP
LF X3,ZHBZHB(X2)
CAIN X0,(X3)
GOTO ORRPOK ;SUBCLASS
L X2,X3
AS
JUMPN X2,TRUE
SA
EXEC ORRPER
ERRI2 QE,<Q2.ERR+^D42>
ASSERT<
NOP [ASCIZ/ INCOMPATIBLE QUALIFICATIONS OF PARAMETERS CORRESPONDING TO FORMAL (%ID) OF (%ID)/]
>
GOTO ORRP.E
FI
ELSE
LF X0,ZQUMOD(XP1)
IF ;IF FORMAL PARAMETER HAS MODE QREFER AND
; TYPE ARITHMETIC THEN THE ACTUAL PARAM.
; IS NOT ALLOWED TO HAVE MODE QNAME
; OR BE A CONSTANT OR AN EXPRESSION
; OTHER THAN %DOT OR %RP
CAIN X0,QREFER
CAILE X1,QLREAL
GOTO FALSE
THEN
IF
IFNEQF XL1,ZIDMOD,QNAME
GOTO FALSE
THEN
EXEC ORRPER
ERRI2 QE,<Q2.ERR+^D43>
ASSERT<
NOP [ASCIZ/ INVALID ACTUAL PARAMETER MODE CORRESPONDING TO FORMAL PARAMETER (%ID) OF (%ID)/]
>
GOTO ORRP.E
FI
IF
WHEN XL1,ZCN
GOTO TRUE
WHENNOT XL1,ZNS
GOTO FALSE
LF ,ZNSGEN(XL1)
CAIE %DOT
CAIN %RP
GOTO FALSE
THEN
ORRPPX: EXEC ORRPER
ERRI2 QE,<Q2.ERR+^D44>
ASSERT<
NOP [ASCIZ/ ILLEGAL EXPRESSION AS ACTUAL PARAMETER CORRESPONDING TO FORMAL (%ID) OF (%ID)/]
>
GOTO ORRP.E
FI
FI
IF ;IF ACTUAL PARAMETER IS A TEXT CONSTANT
; \= NOTEXT
; THEN THE MODE OF THE FORMAL PARAMETER
; IS NOT ALLOWED TO BE QREFER
IFNEQF (XP1,ZQUMOD,QREFER)
GOTO FALSE
CAIE X1,QTEXT
GOTO FALSE
RECTYPE(XL1) IS ZCN
GOTO FALSE
IFEQF (XL1,ZCNVAL,0) ;NOTEXT
GOTO FALSE
THEN
EXEC ORRPER
ERRI2 QE,<Q2.ERR+^D30>
ASSERT<
NOP [ASCIZ/TEXT CONSTANT IS NOT VALID ACTUAL PARAMETER FOR REFERENCE MODE FORMAL (%ID) OF (%ID)/]
>
GOTO ORRP.E
FI
IF ;[174] If formal has type TEXT and mode
; not by value, then the actual parameter
; may not contain a conditional text constant.
CAIE X1,QTEXT
GOTO FALSE
IFEQF (XP1,ZQUMOD,QVALUE)
GOTO FALSE
WHEN XL1,ZCN
GOTO FALSE
L X0,XL1
EXEC ORTXCH
GOTO FALSE
THEN
GOTO ORRPPX
FI
FI
ELSE
IF ;KIND EQUAL
TLNE X0,QKNDM
GOTO FALSE
THEN
LF X1,ZIDTYP(XL1)
LF X0,ZQUTYP(XP1)
IF ;TYPES ARITHMETIC ( <=QLREAL )
CAIG X0,QLREAL
CAILE X1,QLREAL
GOTO FALSE
THEN
IF ;IF KIND = QSIMPLE AND MODE NOT NAME
; CONVERT ACTUAL
; PARAMETER TO FORMAL TYPE
LF X2,ZIDKND(XL1)
CAIE X2,QSIMPLE
GOTO FALSE
LF X2,ZQUMOD(XP1)
CAIN X2,QNAME
GOTO FALSE
THEN
CAIN X2,QREFER
GOTO L3 ;DIFFERENT TYPES ARE NOT ALLOWED
; FOR ARITHM. TYPES IF FORMAL
; PARAM. HAS MODE QREFER
EXEC ORCN
GOTO ORRPOK
FI
LF ,ZIDKND(XL1) ;[35]
CAIE QPROCEDURE ;[35]
CAIN QARRAY ;[35]
GOTO L3 ;[35]
GOTO ORRPOK ;DIFFERENT TYPES ARE NOT ALLOWED
; FOR KIND = QARRAY or QPROCEDURE ;[35]
ELSE
IF ;IF FORMAL PARAM. TYPE IS QRLREA
; THE ACTUAL PARAM. MUST BE
; ARITHMETIC AND CONVERTED TO
; REAL IF IT IS OF TYPE INTEGER
CAIE X0,QRLREA
GOTO FALSE
THEN
IF
CAIE X1,QINTEG
GOTO FALSE
THEN
LI X0,QREAL
EXEC ORCN
LI X1,QREAL
FI
ST X1,YORPAR
CAIG X1,QLREAL
GOTO ORRPOK
SETZM YORPAR
ELSE
IF ;FOR PROCEDURES THE FORMAL
; PARAMETER IS ALLOWED TO BE
; OF TYPE QNOTYPE
IFNEQF (XL1,ZIDKND,QPROCEDURE)
GOTO FALSE
THEN
IFEQF XP1,ZQUTYP,QNOTYPE
GOTO ORRPOK
FI
FI
FI
L3(): EXEC ORRPER
ERRI2 QE,<Q2.ERR+^D32>
seton scerfl ;[35]
li Qrelcd
st ygap
l [rtserr qsorceerr]
genabs
ASSERT<
NOP [ASCIZ/ INVALID ACTUAL PARAMETER TYPE CORRESPONDS TO FORMAL PARAMETER (%ID) OF (%ID)/]
>
GOTO ORRP.E
ELSE
IF ;IF FORMAL PARAMETER KIND = QSIMPLE AND
; ACTUAL PARAMETER KIND = QPROCEDURE
; THEN THE ACTUAL PARAMETER COULD BE
; CHANGED TO KIND QSIMPLE BY CALLING
; ORSM
IFNEQF (XP1,ZQUKND,QSIMPLE)
GOTO FALSE
IFNEQF (XL1,ZIDKND,QPROCEDURE)
GOTO FALSE
THEN
EXCH XL1,XP1
EXEC ORSM
EXCH XL1,XP1
IFEQF (XL1,ZIDKND,QSIMPLE)
GOTO L2 ;KIND EQUAL (=QSIMPLE)
FI
EXEC ORRPER
ERRI2 QE,<Q2.ERR+^D31>
ASSERT<
NOP [ASCIZ/ INVALID ACTUAL PARAMETER KIND CORRESPONDS TO FORMAL PARAMETER (%ID) OF (%ID)/]
>
GOTO ORRP.E
FI
FI
ORRPOK: ;COPY THE ACTUAL PARAMETER NODE
; INTO THE TREE
L X2,YEXPP
SUBI X2,<2*ZNO%S>
ST X2,YEXPP
LD X0,(XL1)
STD X0,(X2)
;BUILD UP A ZID NODE IN XV1-XV2 FROM THE FORMAL
; PARAMETER ZQU NODE, AND PUT IT IN THE TREE
; AFTER THE ACTUAL PARAMETER
WLF XV1,ZQUZHE(XP1)
WLF XV2,ZQUZB(XP1)
SETOFA ZNOTER(XV1)
SETONA ZNOLST(XV1)
SF XP1,ZIDZQU(,XV1)
SETF QZID,ZNOTYP(,XV1)
STD XV1,ZNO%S(X2)
;TRANSFORM THE ACTUAL PARAMETER NODE IN THE OPERAND
; STACK TO A ZNS NODE WITH ZNSGEN = %PARM
SETF QZNS,ZNOTYP(XL1)
SF X2,ZNSZNO(XL1)
SETF %PARM,ZNSGEN(XL1)
SETOFF ZNOLST(XL1)
ORRP.E: ; ERROR EXIT FROM PARAMETER CHECKS
;LET XP1 AND XL1 POINT TO NEXT NODE
STEP (XP1,ZQU)
STEP (XL1,ZID)
OD
RETURN
EPROC
SUBTTL ORRP
ORRP: PROC
;SEARCH BACKWARDS IN THE OPERAND STACK FOR A ZOS NODE
; LOOK UP ALL ZLI NODES ON THE WAY
; COUNT THE NUMBER OF OPERANDS PASSED (I.E. NUMBER OF PARAMETERS)
SETZM YORPAR
HRRZ XP1,YOPSTP
SOJ XP1,
LOOP
LF X1,ZNOTYP(XP1)
ASSERT< CAIL X1,ZNN%V
RFAIL WRONG PARAM. NODE TYPE IN ORRP
>
;THE NEXT LITERAL IS INDERXED BY X1
XCT [GOTO FALSE ;END OF LOOP
GOTO [AOS YNZID ;ZLI OPERAND
EXEC ORLU
GOTO .+1] ;OUTSIDE LITERALS
AOS YNZCN
AOS YNZID
AOS YNZNS](X1)
AOS YNOPD
SUBI XP1,ZNO%S
AS
GOTO TRUE
SA
;SET YFOP TO POINT TO THE FIRST PARAMETER NODE
LI X0,ZOS%S(XP1)
ST X0,YFOP
;SET YSTEPP TO -<2*NUMBER OF PARAM.-1>,,YFOP
L X1,X0
SUB X1,YOPSTP
HRL X0,X1
ST X0,YSTEPP
; LOOK UP THE NODE IN FRONT OF THE ZOS NODE IF IT IS A ZLI NODE
SUBI XP1,ZNO%S
IF
RECTYPE(XP1) IS ZLI
GOTO FALSE
THEN
EXEC ORLU
ELSE ;IF IT IS A ZNS NODE (I.E. DOT NOTATION) FIND ITS SECOND OPERAND
IF
RECTYPE(XP1) IS ZNS
GOTO FALSE
THEN
ASSERT< IFNEQF (XP1,ZNSGEN,%DOT)
RFAIL (ZNS BUT NOT %DOT IN FRONT OF ZOS IN ORRP)>
LF XP1,ZNSZNO(XP1)
STEP XP1,ZNO
FI
FI
ASSERT< WHENNOT XP1,ZID
RFAIL (PARENT ZID NOT FOUND IN ORRP)>
L XP2,XP1
;NOW XP1 AND XP2 POINTS TO THE ZID NODE WHOSE FIRST PARAMETER
; NODE LIES IN THE OPERAND STACK AT YFOP
LF X1,ZIDKND(XP1)
;IF SWITCH (I.E. LABEL PROCEDURE) THEN CHECK THAT THER IS ONE
; PARAMETER ONLY, AND THAT THIS SWITCH INDEX IS OF KIND SIMPLE
; AND CONVERT IT TO TYPE INTEGER
IF
CAIE X1,QPROCEDURE
GOTO FALSE
IFNEQF (XP1,ZIDTYP,QLABEL)
GOTO FALSE
THEN
IF
SOSE YNOPD
GOTO FALSE
THEN
L XP1,YFOP
EXEC ORSM
L XL1,XP1
LI X0,QINTEGER
EXEC ORCN
ELSE
LF X2,ZIDZQU(XP2)
LF X2,ZQULID(X2)
ERROR1 9, X2, INCORRECT NUMBER OF SUBSCRIPTS TO (%ID);
FI
GOTO L1
FI
IF ;KIND = QPROCEDURE OR QCLASS?
CAIN X1,QPROCEDURE
GOTO TRUE
CAIE X1,QCLASS
GOTO FALSE
THEN ;FOR PROCEDURE AND CLASS CHECK THAT THE
; PARAMETERS WERE NOT PRECEDED BY A [
L X2,YFOP
SUBI X2,ZNO%S
IF
IFOFF ZOSLB(X2)
GOTO FALSE
THEN
LF X2,ZIDZQU(XP2)
LF X2,ZQULID(X2)
ERROR1 20, X2, LEFT BRACKET AFTER (%ID) SHOULD BE LEFT PARENTHESIS
FI
IF ;IF MODE QDECLARED THEN CHECK NUMBER AND
; COMPATIBILITY OF PARAMETERS
IFNEQF (XP2,ZIDMOD,QDECLARED)
GOTO FALSE
THEN
LF XP1,ZIDZQU(XP2)
LF XP1,ZQUZB(XP1)
CAIN X1,QCLASS
GOTO L2
IFON ZHBNCK(XP1)
GOTO FALSE
L2(): SETZ X3,
L X1,XP1
LOOP
ADD X3,OFFSET(ZHBNRP)(X1)
IFN<<%ZHBNRP-7>>,<
CFAIL (ZHBNRP MASK IN ORRP MUST BE CHANGED)>
AND X3,[776000,,0]
LF X1,ZHBZHB(X1)
AS
JUMPE X1,FALSE
WHEN X1,ZHB
GOTO TRUE
SA
LF X0,ZHBNRP(,X3-<OFFSET(ZHBNRP)>)
IF
CAME X0,YNOPD
GOTO FALSE
THEN
L XL1,YFOP ;LET XL1 POINT TO THE FIRST
; ACTUAL PARAMETER
IF ;IF CLASS AND A PREFIX CLASS EXIST
; THEN STACK THE ZHB POINTER TO THE
; ATTRIBUTE LIST HEADER AND COUNT THE
; NUMBER OF STACKINGS IN STKNUM
IFNEQF (XP2,ZIDKND,QCLASS)
GOTO FALSE
THEN
SETZM YSTKNU
WHILE
IFEQF (XP1,ZHBZHB,0)
GOTO FALSE
DO
STACK XP1
AOS YSTKNU
LF XP1,ZHBZHB(XP1)
OD
;PROCESS CLASS PARAMETERS
LOOP
EXEC ORRPPP
AS
SKIPN YSTKNU
GOTO FALSE
SOS YSTKNU
UNSTK XP1
GOTO TRUE
SA
ELSE ;PROCESS PROCEDURE PARAMETERS
EXEC ORRPPP
FI
ASSERT< ;TEST THAT ALL ACTUAL PARAMETERS HAS
; BEEN PROCESSED
SUB XL1,YOPSTP
SOJ XL1,
TRNE XL1,-1
RFAIL (INCORRECT PARAMETER PROCESSING IN ORRP)>
ELSE
LF X2,ZIDZQU(XP2)
LF X2,ZQULID(X2)
ERROR1 7, X2, INCORRECT NUMBER OF PARAMETERS TO (%ID);
FI
ELSE ;[133]
EXEC ORRPIV ;[133] Search for system procedures
FI
ELSE
IF ;FOR ARRAY THE NUMBER OF SUBSCRIPTS ARE CHECKED
; IF ITS MODE IS QDECLARED
; EACH SUBSCRIPT NODE ARE CHECKED TO BE OF KIND
; QSIMPLE AND CONVERTED TO TYPE QINTEGER
IFNEQF (XP2,ZIDKND,QARRAY)
GOTO FALSE
THEN
IF
IFNEQF (XP2,ZIDMOD,QDECLARED)
GOTO TRUE
LF XP1,ZIDZQU(XP2)
LF X0,ZQUNSB(XP1)
CAME X0,YNOPD
GOTO FALSE
THEN
L XL1,YFOP
LOOP
IF LF ,ZNSTYP(XL1)
CAIG QLREAL
GOTO FALSE
THEN ; NONARITHMETIC SUBSCRIPT
LF X2,ZIDZQU(XP2)
LF X2,ZQULID(X2)
ERROR1 16,X2,NONARITHMETHIC SUBSCRIPT TO XXXX
ELSE
EXCH XP1,XL1
EXEC ORSM
EXCH XP1,XL1
LI X0,QINTEGER
EXEC ORCN
FI
STEP (XL1,ZID)
AS
HRRZ X1,YOPSTP
CAIG XL1,(X1)
GOTO TRUE
SA
ELSE
LF X2,ZIDZQU(XP2)
LF X2,ZQULID(X2)
ERROR1 9, X2, INCORRECTNUMBER OF SUBSCRIPTS TO (%ID);
FI
ELSE
IF
IFEQF (XP2,ZIDKND,QUNDEF)
GOTO FALSE
THEN
LF X2,ZIDZQU(XP2)
LF X2,ZQULID(X2)
ERROR1 21, X2, SIMPLE QUANTITY (%ID) IS USED AS ARRAY FUNCTION PROCEDURE CLASS OR SWITCH
FI
FI
FI
;REMOVE THE ZOS NODE FROM THE OPERAND STACK
L1(): MOVNI X3,ZNO%S ;LET YFOP POINT TO THE ZOS NODE
ADDB X3,YFOP
;***AUBEG
; SPECIFY X0
LD X0,-ZNO%S(X3)
STD X0,(X3)
;***AUEND
;BUILD UP A ZNS NODE IN XV1-XV2
LD XV1,(XP2)
SETF QZNS,ZNOTYP(,XV1)
LF X0,ZIDKND(XP2)
IF ;FOR PROCEDURE AND CLASS THE ZNSGEN IS SET TO %PCALL
; ELSE TO %RP
CAIG X0,QARRAY
GOTO FALSE
IFEQF XP2,ZIDTYP,QLABEL
GOTO FALSE
THEN
SETF %PCALL,ZNSGEN(,XV1)
; ZNSSEF IS SET AND
; ZNSLEV IS SET TO THE CURRENT SOURCE LEVEL
SETONA ZNSSEF(XV2)
L X1,YZHET
LF X1,ZHESOL(X1)
SF X1,ZNSLEV(,XV1)
IF SKIPN X1,YORPAR
GOTO FALSE
THEN ; STANDARD PROCEDURE WITH LONG/SHORT VERSIONS
SF X1,ZNSTYP(,XV1)
SETZM YORPAR
FI
ELSE
SETF %RP,ZNSGEN(,XV1)
EXEC ORBU
FI
SETF QSIMPLE,ZNSKND(,XV1)
SETOFA ZNOTER(XV1) ; ZNS NODES ARE NOT TERMINAL
EXEC ORMV
;ORMV WILL PLACE THE ZNS NODE IN XV1-2 AT YFOP.
; CORRECT POSITION IS THE NODE IN FRONT OF YFOP.
L X3,YFOP
STD XV1,-ZNO%S(X3)
L [-ZNO%S,,-ZNO%S]
ADDM YOPSTP
RETURN
EPROC
SUBTTL ORRPIV [133]
COMMENT;
PURPOSE: This routine is called from ORRP when it processes a formal
or virtual procedure. It checks if there are any system
procedures as actual parameters. If there are, those procedures
which haven't any parameters are preceded by a %PCALL node.
[174] It also checks if there are any conditional text constants
in the parameters.
ENTRY: ORRPIV
NORMAL EXIT: RETURN
ERROR EXIT: BRANCH O2AB (Too complicated expression)
INPUT: Actual parameters in operand stack starting at YFOP and
ending at YOPSTP.
;
ORRPIV: PROC
SAVE XP2
L XP1,YFOP ;ADDRESS OF FIRST OPERAND
L XP2,YNOPD ;NUMBER OF PARAMETERS
LOOP
L X2,XP1
IF
WHENNOT X2,ZNS
GOTO FALSE
THEN
LF X2,ZNSZNO(X2)
STEP X2,ZNO
FI
IF
WHEN XP1,ZCN
GOTO FALSE
IFOFF ZIDSYS(XP1)
GOTO FALSE
IFNEQF XP1,ZIDKND,QPROCEDURE
GOTO FALSE
LF X2,ZIDZQU(X2)
LF X2,ZQUZB(X2)
IFNEQF X2,ZHBNRP,0
GOTO FALSE
THEN ;APPEND A %PCALL NODE
L X2,YEXPP
SUBI X2,2
IF
HRRZ YOPSTP
CAIGE (X2)
GOTO FALSE
THEN
ERROR2 35,TOO COMPLICATED EXPRESSION
GOTO O2AB
FI
ST X2,YEXPP
LD XV1,(XP1)
SETONA ZNOLST(XV1)
STD XV1,(X2) ;MOVE NODE TO TREE
SETOFA ZNOLST(XV1)
SETOFA ZNOTER(XV1)
SETF QZNS,ZNOTYP(,XV1)
SETF QSIMPLE,ZNSKND(,XV1)
SF X2,ZNSZNO(,XV1)
SETONA ZNSSEF(XV2)
L X1,YZHET
LF X1,ZHESOL(X1)
SF X1,ZNSLEV(,XV1)
SETF %PCALL,ZNSGEN(,XV1)
STD XV1,(XP1)
FI
IF ;[174]
LF X0,ZNSTYP(XP1)
CAIE X0,QTEXT
GOTO FALSE
WHEN XP1,ZCN
GOTO FALSE
L X0,XP1
EXEC ORTXCH
GOTO FALSE
THEN ;ILLEGAL
ERROR2 62,ILLEGAL USE OF TEXT STRING
FI
STEP XP1,ZNO
AS
SOJG XP2,TRUE
SA
RETURN
EPROC
SUBTTL ORTXCH [174]
COMMENT;
PURPOSE: This routine checks if a text expression contains
any text value constants.
CALL: EXEC ORTXCH
<normal return>
<error return>
Error return means that a text value constant has been found.
INPUT: R0 points to a node in the expression tree.
;
ORTXCH: PROC
BEGIN
STACK XCUR ;SAVE REGISTER
STACK [0]
STACK X0
L1():
UNSTK XCUR
IF
JUMPN XCUR,FALSE
THEN ;NO CONSTANT DETECTED
UNSTK XCUR ;RESTORE REGISTER
RETURN
FI
WHEN XCUR,ZLI
GOTO L1
WHEN XCUR,ZID
GOTO L1
IF
WHEN XCUR,ZCN
GOTO FALSE
THEN ;EXPRESSION
LF X0,ZNSGEN(XCUR)
CAIE X0,%IFEX1
GOTO L1
LF XCUR,ZNSZNO(XCUR)
STEP XCUR,ZNO
LF XCUR,ZNSZNO(XCUR)
STACK XCUR
STEP XCUR,ZNO
STACK XCUR
GOTO L1
FI
; XCUR POINTS TO CONSTANT, CHECK FOR NOTEXT
LF X0,ZCNVAL(XCUR)
JUMPE X0,L1 ;NOTEXT IF 0
; E R R O R
LOOP ;EMPTY STACK
UNSTK XCUR
AS
JUMPN XCUR,TRUE
SA
UNSTK XCUR ;RESTORE REGISTER
AOS (XPDP) ;PERFORM SKIP RETURN
RETURN
ENDD
EPROC
SUBTTL ORSM
COMMENT;
PURPOSE: CHECK THAT AN EXPRESSION NODE IN THE OPERAND STACK
IS SIMPLE
ENTRY: ORSM
INPUT ARGUMENTS: THE NODE ADDRESS IS PASSED IN XP1
NORMAL EXIT: RETURN
ERROR EXIT: RETURN
CALL FORMAT: EXEC ORSM
;
ORSM: PROC
;EXIT AT ONCE IF THE NODE IS A ZCN RECORD OR ITS KIND IS
; QSIMPLE OR QUNDEF
LF X1,ZIDKND(XP1)
CAIN X1,QSIMPLE
RETURN
STACK XP1 ;XP1 WILL BE CHANGED IF DOT NOTATION
;IF IT IS A ZNS NODE (I.E. DOT NOTATION) FIND ITS SECOND OPERAND
IF
RECTYPE(XP1) IS ZNS
GOTO FALSE
THEN
ASSERT< IFNEQF (XP1,ZNSGEN,%DOT)
RFAIL (ZNS BUT NOT %DOT IN ORSM)>
LF XP1,ZNSZNO(XP1)
STEP XP1,ZNO
FI
WHEN XP1,ZLI
EXEC ORLU
ASSERT< WHENNOT XP1,ZID
RFAIL (NO ZID FOUND IN ORSM)>
;IF THE KIND IS QPROCEDURE AND ITS ZQUIB = 1 AND T IS THE FIRST OPERAND AND
; XCUR = %BECOM OR %DENOTE THEN ZIDMOD := QDECLARED,
; ZIDKND := QSIMPLE AND ZIDZHE := ZIDZQU.ZQUZB
IF
CAIE X1,QPROCEDURE
GOTO FALSE
LF ,ZNSTYP(XP1)
CAIN ,QLABEL
GOTO FALSE ;SWITCH ILLEGAL HERE
THEN
LF X1,ZIDZQU(XP1)
IF
IFOFF ZQUIB(X1)
GOTO FALSE
HRRZ YFOP
CAIE (XP1)
GOTO FALSE
CAIN XCUR,%BECOM
GOTO TRUE
CAIE XCUR,%DENOT
GOTO FALSE
THEN
SETF QDECLARED,ZIDMOD(XP1)
SETF QSIMPLE,ZIDKND(XP1)
ZF ZIDZHE(XP1)
UNSTK XP1
RETURN
FI
;IF THE PROCEDURE HAS ZERO PARAMETERS OR IS NOT DECLARED, THEN THE
; NODE IS COPIED INTO THE TREE AND A ZNS RECORD WITH ZNSGEN = %PCALL,
; ZNSSEF SET, ZNSLEV =CURRENT SOURCE LEVEL
; AND ZNSKND = QSIMPLE IS INSERTED
LF X1,ZQUZB(X1) ; GET ZHB OF PROCEDURE WITH PARAM COUNT
IF
IFEQF (X1,ZHBNRP,0)
GOTO TRUE
IFEQF (XP1,ZIDMOD,QDECLARED)
GOTO FALSE
THEN
UNSTK XP1
LD XV1,(XP1)
SETF %PCALL,ZNSGEN(,XV1)
SETF QZNS,ZNOTYP(,XV1)
SETF QSIMPLE,ZNSKND(,XV1)
SETONA ZNSSEF(XV2)
L X1,YZHET
LF X1,ZHESOL(X1)
SF X1,ZNSLEV(,XV1)
HRROI X1,-ZID%S
ADDB X1,YEXPP
SF X1,ZNSZNO(,XV1)
EXCH XV1,(XP1)
EXCH XV2,1(XP1)
HRLZI X0,3B<%ZNOLST+^D18>
TDO XV1,X0 ;SETON ZNOLST AND ZNOTER
STD XV1,(X1)
RETURN
FI
FI
;ERROR
; ACCEPT KIND UNDEFINED
; REPLACE THE OPERAND BY THAT OF AN UNDECLARED IDENTIFIER
; AND GIVE AN ERROR MESSAGE
LF X1,ZIDKND(XP1)
IF
CAIE X1,QUNDEF
GOTO FALSE
THEN
UNSTK XP1
RETURN ;KIND UNDEFINED
FI
LF X2,ZIDZQU(XP1)
LF X2,ZQULID(X2)
SETF QUNDEF,ZIDTYP(XP1)
SETF QUNDEF,ZIDKND(XP1)
LI X0,YUNDEC
SF X0,ZIDZQU(XP1)
IF
;LINE SYMBOL IN XCUR
TRNN XCUR,400K
GOTO FALSE
THEN
;PROCEDURE CALL WITHOUT PARAMETERS
ERROR1 17,X2,PARAMETERS OMITTED TO (%ID)
UNSTK XP1 ;RESTORE XP1
ELSE
UNSTK XP1 ;RESTORE XP1
IF CAIE XCUR,%RP
GOTO FALSE
THEN ; ARRAY SUBSCRIPT
ERROR1 17,X2,param or subscr to xxx omitted
RETURN
FI
IF
L YFOP
CAIN (XP1)
GOTO FALSE
THEN
IF SUBI ,(XP1)
ADDI 2
JUMPE ,FALSE
THEN
ERROR2 28,NOT SIMPLE OPERAND AFTER UNTIL
ELSE
ERROR1 2, XCUR, INVALID 2ND OPERAND KIND OF OPERATOR (%OPT)
FI
ELSE
ERROR1 29, XCUR, INVALID 1ST OPERAND KIND OF OPERATOR (%OPT)
FI
FI
RETURN
EPROC
SUBTTL ORTY
COMMENT;
PURPOSE: TO DETERMINE THE TYPE FIELD OF A RESULT OPERATOR NODE IN
XV1-XV2 FROM THE TYPES OF THE OPERANDS ACCORDING TO
RULES DETERMINED BY AN INDEX PASSED IN XP1
ENTRY: ORTY
INPUT ARGUMENTS: THE INDEX PASSED IN XP1 HAS THE FOLLOWING MEANING
XP1 MEANING
----------------------------------------------------------------
QRSAME TAKE THE TYPE OF THE FIRST OPERAND AND IF IT IS REF AND
THE LAST OPERAND IS OF KIND CLASS, THEN THE QUAL. IS SET
TO THIS CLASS ELSE TO THE QUAL. OF THE FIRST OPERAND
QRLAST TAKE TYPE AND QUAL. OF THE LAST OPERAND
(I.E. SECOND OPERAND)
QRBOOL RESULT TYPE IS SET TO BOOLEAN
QRCLAS RESULT TYPE IS REF. COPY QUAL. FROM FIRST OPERAND IF ITS
TYPE IS REF, AND TAKE THE CLASS NAME IF ITS KIND IS
CLASS
NORMAL EXIT: RETURN
CALL FORMAT: EXEC ORTY
;
ORTY: L X1,YSTEPP
ASSERT< CAILE XP1,QRSAME
RFAIL WRONG XP1 IN ORTY
>
XCT [RETURN
GOTO ORTYCL
GOTO ORTYBO
GOTO ORTYLA
GOTO ORTYSA](XP1) ;LITERAL INDEXED BY XP1
ORTYSA: LF X2,ZIDTYP(X1) ;TAKE TYPE OF FIRST OPERAND
LF X3,ZIDZDE(X1) ;SAVE QUAL. OF FIRST OPERAND
IF ;TYPE REF?
CAIE X2,QREF
GOTO FALSE
THEN ;FIND LAST OPERAND
HRR X1,YOPSTP
SOJ X1,
IF ;KIND CLASS?
IFNEQF X1,ZIDKND,QCLASS
GOTO FALSE
THEN ;SET QUAL.TO THIS CLASS
LF X3,ZIDZQU(X1)
FI
FI
GOTO ORTYEX
ORTYLA: LF X2,ZIDTYP(X1,ZNO%S) ;TAKE TYPE OF SECOND OPERAND
LF X3,ZIDZDE(X1,ZNO%S) ; AND ITS QUALIFICATION
GOTO ORTYEX
ORTYBO: LI X2,QBOOLEAN ;SET TYPE TO BOOLEAN
GOTO ORTYRE
ORTYCL: LI X2,QREF ;SET TYPE TO REF
IFEQF X1,ZIDTYP,QUNDEF ;[134]
LI X2,QUNDEF
IF
RECTYPE(X1) IS ZNS
GOTO FALSE
THEN
;DOT NOTATION
LF X1,ZNSZNO(X1)
FI
IF ;FIRST OPERAND KIND QCLASS?
IFNEQF X1,ZIDKND,QCLASS
GOTO FALSE
THEN ;SET QUAL. TO THIS CLASS
LF X3,ZIDZQU(X1)
ELSE
LF X3,ZIDZDE(X1) ;COPY QUAL. FROM FIRST OPERAND
FI
ORTYEX: SF X3,ZNSZQU(,XV1)
ORTYRE: SF X2,ZNSTYP(,XV1)
RETURN
LIT
RELOC
VAR
END