mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-12-09 23:03:02 +00:00
Upload
Digital Research
This commit is contained in:
215
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/basics.for
Normal file
215
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/basics.for
Normal file
@@ -0,0 +1,215 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C BASICS.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler parses and generates code for
|
||||
C the following 'basic' statement types: assignment statements,
|
||||
C call statements, goto statements, return statements, and i8086-
|
||||
C dependent statements.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 08SEP81 Alex Hunter 1. Use DO-WHILE (cosmetic change). (V5.1)
|
||||
C 21OCT81 Alex Hunter 1. Basic block analysis. (V5.5)
|
||||
C 10NOV81 Alex Hunter 1. Add EFFECTS module. (V6.0)
|
||||
C 14JAN82 Alex Hunter 1. Treat GOTO <keyword> as GOTO <identifier>.
|
||||
C (V6.5)
|
||||
C
|
||||
C***********************************************************************
|
||||
INTEGER*2 FUNCTION ASSIGNMENT_STATEMENT(N)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
CODE=NULL
|
||||
|
||||
10 CALL MUSTBE(ID)
|
||||
CALL LOOKUP_SYMBOL
|
||||
IF (SYMBOL_KIND(SYMBOL_INDEX).EQ.S_PROC) THEN
|
||||
CALL ERROR('PROCEDURE ILLEGAL AS LEFTHAND SIDE OF ASSIGNMENT: '
|
||||
# //SYMBOL_PLM_ID(SYMBOL_INDEX))
|
||||
ENDIF
|
||||
LHS=VARIABLE_REFERENCE(0)
|
||||
CODE=MAKE_NODE(OP_ALSO,CODE,MAKE_NODE(OP_MOV,NULL,LHS,0,0,0),
|
||||
# 0,0,0)
|
||||
IF (TT.EQ.D_COMMA) THEN
|
||||
CALL GETTOK
|
||||
GO TO 10
|
||||
ENDIF
|
||||
|
||||
CALL MATCH(D_EQ)
|
||||
RHS=EXPRESSION(1)
|
||||
|
||||
OPNODE_OPND1(OPNODE_OPND2(CODE))=RHS
|
||||
CALL DETERMINE_EFFECTS_OF_ASSIGNMENT(LHS)
|
||||
|
||||
CODE1=OPNODE_OPND1(CODE)
|
||||
DO WHILE (CODE1.NE.NULL)
|
||||
OPNODE_OPND1(OPNODE_OPND2(CODE1))=REPLICA(RHS)
|
||||
LHS=OPNODE_OPND2(OPNODE_OPND2(CODE1))
|
||||
CALL DETERMINE_EFFECTS_OF_ASSIGNMENT(LHS)
|
||||
CODE1=OPNODE_OPND1(CODE1)
|
||||
ENDDO
|
||||
|
||||
CALL MATCH(D_SEMI)
|
||||
ASSIGNMENT_STATEMENT=CODE
|
||||
|
||||
RETURN
|
||||
END
|
||||
C----------------------------------------------------
|
||||
INTEGER*2 FUNCTION CALL_STATEMENT(N)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
INTEGER*2 ARGS(100)
|
||||
|
||||
CALL MATCH(K_CALL)
|
||||
CALL MUSTBE(ID)
|
||||
CALL LOOKUP_SYMBOL
|
||||
PROC_IX=SYMBOL_INDEX
|
||||
IF (SYMBOL_KIND(PROC_IX).EQ.S_PROC) THEN
|
||||
IF (SYMBOL_TYPE(PROC_IX).NE.0) THEN
|
||||
CALL WARN('TYPED PROCEDURE USED IN CALL STATEMENT: '//
|
||||
# SYMBOL_PLM_ID(PROC_IX))
|
||||
ENDIF
|
||||
PROC_BASE=NULL
|
||||
CALL GETTOK
|
||||
ELSE
|
||||
PROC_BASE=DATA_REFERENCE(0,2)
|
||||
IF (NODE_TYPE(PROC_BASE).NE.S_PTR.AND.
|
||||
# NODE_TYPE(PROC_BASE).NE.S_WORD.AND.
|
||||
# NODE_TYPE(PROC_BASE).NE.S_LONG) THEN
|
||||
CALL WARN('INDIRECT CALL THRU NON-WORD/POINTER '//
|
||||
# 'PROBABLY WON''T WORK')
|
||||
ENDIF
|
||||
PROC_IX=0
|
||||
ENDIF
|
||||
|
||||
ARGLIST=NULL
|
||||
NARGS=0
|
||||
IF (TT.EQ.D_LP) THEN
|
||||
10 CALL GETTOK
|
||||
NARGS=NARGS+1
|
||||
ARGLIST=MAKE_NODE(OP_ARG,ARGLIST,EXPRESSION(1),0,0,0)
|
||||
IF (TT.EQ.D_COMMA) GO TO 10
|
||||
CALL MATCH(D_RP)
|
||||
ENDIF
|
||||
|
||||
IF (PROC_IX.NE.0.AND.NARGS.NE.SYMBOL_LIST_SIZE(PROC_IX)) THEN
|
||||
CALL WARN('WRONG NUMBER OF ARGS TO '//
|
||||
# SYMBOL_PLM_ID(PROC_IX))
|
||||
ENDIF
|
||||
|
||||
PROC=MAKE_ATOM(PROC_IX,0,PROC_BASE,NULL,S_BYTE,0,0)
|
||||
CODE=MAKE_NODE(OP_CALL,PROC,ARGLIST,0,0,0)
|
||||
CODE=MAKE_NODE(OP_MOV,CODE,R0,0,0,0)
|
||||
NODE_TYPE(R0)=S_BYTE
|
||||
|
||||
CALL DETERMINE_EFFECTS_OF_CALLING(PROC_IX)
|
||||
|
||||
CALL MATCH(D_SEMI)
|
||||
CALL_STATEMENT=CODE
|
||||
RETURN
|
||||
END
|
||||
C----------------------------------------------------
|
||||
INTEGER*2 FUNCTION GOTO_STATEMENT(N)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
IF (TT.EQ.K_GO) THEN
|
||||
CALL GETTOK
|
||||
CALL MATCH(K_TO)
|
||||
ELSE
|
||||
CALL MATCH(K_GOTO)
|
||||
ENDIF
|
||||
CALL BREAK
|
||||
IF (TT.LT.101.OR.TT.GT.199) CALL MUSTBE(ID)
|
||||
H=HASH(IDENTIFIER)
|
||||
SYMBOL_INDEX=HASH_BUCKET(H)
|
||||
10 IF (SYMBOL_INDEX.GE.SYMBOL_TOP(BLOCK_LEVEL-1)+1) THEN
|
||||
IF (SYMBOL_PLM_ID(SYMBOL_INDEX).EQ.IDENTIFIER) THEN
|
||||
GO TO 20
|
||||
ENDIF
|
||||
SYMBOL_INDEX=SYMBOL_CHAIN(SYMBOL_INDEX)
|
||||
GO TO 10
|
||||
ENDIF
|
||||
|
||||
CALL ENTER_SYMBOL
|
||||
SYMBOL_KIND(SYMBOL_INDEX)=S_LABEL
|
||||
SYMBOL_REF(SYMBOL_INDEX)=S_UNRESOLVED
|
||||
|
||||
20 IF (SYMBOL_REF(SYMBOL_INDEX).EQ.S_EXT) THEN
|
||||
CALL EMIT('JMP '//SYMBOL_VAX_ID(SYMBOL_INDEX))
|
||||
ELSE
|
||||
CALL EMIT('BRW '//SYMBOL_VAX_ID(SYMBOL_INDEX))
|
||||
ENDIF
|
||||
|
||||
PATH=.FALSE.
|
||||
|
||||
CALL GETTOK
|
||||
CALL MATCH(D_SEMI)
|
||||
GOTO_STATEMENT=NULL
|
||||
RETURN
|
||||
END
|
||||
C----------------------------------------------------
|
||||
INTEGER*2 FUNCTION RETURN_STATEMENT(N)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
CALL MATCH(K_RETURN)
|
||||
|
||||
TYPE=SYMBOL_TYPE(PROC_INDEX(PROC_LEVEL))
|
||||
|
||||
IF (TT.NE.D_SEMI) THEN
|
||||
|
||||
IF (TYPE.EQ.0) THEN
|
||||
CALL ERROR('CAN''T RETURN VALUE FROM UNTYPED PROCEDURE')
|
||||
TYPE=S_LONG
|
||||
ENDIF
|
||||
|
||||
RESULT=MAKE_NODE(OP_BYTE+TYPE-S_BYTE,EXPRESSION(1),NULL,0,0,0)
|
||||
RESULT=MAKE_NODE(OP_MOV,RESULT,R0,0,0,0)
|
||||
NODE_TYPE(R0)=TYPE
|
||||
BASIC_BLOCK=MAKE_NODE(OP_THEN,BASIC_BLOCK,RESULT,0,0,0)
|
||||
|
||||
ELSEIF (TYPE.NE.0) THEN
|
||||
CALL ERROR('MUST RETURN VALUE FROM TYPED PROCEDURE')
|
||||
ENDIF
|
||||
|
||||
CALL BREAK
|
||||
CALL MATCH(D_SEMI)
|
||||
CALL EMIT('RET')
|
||||
|
||||
PATH=.FALSE.
|
||||
|
||||
RETURN_STATEMENT=NULL
|
||||
RETURN
|
||||
END
|
||||
C----------------------------------------------------
|
||||
INTEGER*2 FUNCTION i8086_DEPENDENT_STATEMENTS(N)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CALL GETTOK
|
||||
CALL MATCH(D_SEMI)
|
||||
CALL WARN('8086 DEPENDENT STATEMENT IGNORED')
|
||||
i8086_DEPENDENT_STATEMENTS=NULL
|
||||
RETURN
|
||||
END
|
||||
119
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/block.for
Normal file
119
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/block.for
Normal file
@@ -0,0 +1,119 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C BLOCK.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler handles block entries
|
||||
C and exits.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 16OCT81 Alex Hunter 1. Added disclaimer notice.
|
||||
C 14NOV81 Alex Hunter 1. Avoid unnecessary jump if no path. (V6.2)
|
||||
C 2. Copy symbol serial no. and psect fields.
|
||||
C
|
||||
C***********************************************************************
|
||||
SUBROUTINE BLOCK_BEGIN
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
C
|
||||
IF (BLOCK_LEVEL.GE.BLOCK_MAX)
|
||||
# CALL FATAL('BLOCKS NESTED TOO DEEPLY')
|
||||
BLOCK_LEVEL=BLOCK_LEVEL+1
|
||||
SYMBOL_TOP(BLOCK_LEVEL)=SYMBOL_TOP(BLOCK_LEVEL-1)
|
||||
MEMBER_TOP(BLOCK_LEVEL)=MEMBER_TOP(BLOCK_LEVEL-1)
|
||||
PARAM_TOP(BLOCK_LEVEL)=PARAM_TOP(BLOCK_LEVEL-1)
|
||||
STRINGS_TOP(BLOCK_LEVEL)=STRINGS_TOP(BLOCK_LEVEL-1)
|
||||
RETURN
|
||||
C
|
||||
C---------------------------
|
||||
ENTRY BLOCK_END
|
||||
C---------------------------
|
||||
IF (BLOCK_LEVEL.EQ.0) CALL BUG('BLOCK LEVEL UNDERFLOW')
|
||||
DO 10 I=SYMBOL_TOP(BLOCK_LEVEL),SYMBOL_TOP(BLOCK_LEVEL-1)+1,-1
|
||||
H=HASH(SYMBOL_PLM_ID(I))
|
||||
HASH_BUCKET(H)=SYMBOL_CHAIN(I)
|
||||
10 CONTINUE
|
||||
BLOCK_LEVEL=BLOCK_LEVEL-1
|
||||
|
||||
C---------- HANDLE UNRESOLVED LABELS AND UNDEFINED FORWARD REFS
|
||||
|
||||
DO 40 I=SYMBOL_TOP(BLOCK_LEVEL)+1,SYMBOL_TOP(BLOCK_LEVEL+1)
|
||||
IF (SYMBOL_REF(I).EQ.S_FORWARD.OR.
|
||||
# BLOCK_LEVEL.EQ.0.AND.(SYMBOL_FLAGS(I).AND.S_UNDEF).NE.0) THEN
|
||||
CALL ERROR('NEVER GOT DEFINED: '//SYMBOL_PLM_ID(I))
|
||||
ELSEIF (SYMBOL_KIND(I).EQ.S_LABEL.AND.
|
||||
# (SYMBOL_FLAGS(I).AND.S_UNDEF).NE.0) THEN
|
||||
! -- UNRESOLVED LABEL. ----
|
||||
DO 20 J=SYMBOL_TOP(BLOCK_LEVEL-1)+1,SYMBOL_TOP(BLOCK_LEVEL)
|
||||
IF (SYMBOL_PLM_ID(I).EQ.SYMBOL_PLM_ID(J)) THEN
|
||||
IF (SYMBOL_KIND(J).NE.S_LABEL) THEN
|
||||
CALL ERROR('GOTO TARGET NOT A LABEL: '//SYMBOL_PLM_ID(I))
|
||||
ELSEIF ((SYMBOL_FLAGS(J).AND.S_UNDEF).EQ.0) THEN
|
||||
IF (SYMBOL_REF(J).EQ.S_EXT) THEN
|
||||
IF (PATH) CALL GENERATE_LOCAL_LABEL(LL)
|
||||
IF (PATH) CALL EMIT('BRB '//LOCAL_LABEL(LL,N0))
|
||||
CALL EMIT_LABEL(I)
|
||||
CALL EMIT('JMP '//SYMBOL_VAX_ID(J))
|
||||
IF (PATH) CALL EMIT_LOCAL_LABEL(LL)
|
||||
ELSE
|
||||
CALL EMIT1(SYMBOL_VAX_ID(I)(:LNB(SYMBOL_VAX_ID(I)))
|
||||
# //' = '//
|
||||
# SYMBOL_VAX_ID(J)(:LNB(SYMBOL_VAX_ID(J))))
|
||||
ENDIF
|
||||
ELSE
|
||||
SYMBOL_REF(I)=SYMBOL_REF(J)
|
||||
SYMBOL_FLAGS(I)=SYMBOL_FLAGS(J).AND..NOT.S_PUBLIC
|
||||
GO TO 30
|
||||
ENDIF
|
||||
GO TO 40
|
||||
ENDIF
|
||||
20 CONTINUE
|
||||
C---------- LABEL STILL UNRESOLVED -- COPY DOWN TO OUTER BLOCK.
|
||||
30 SYMBOL_TOP(BLOCK_LEVEL)=SYMBOL_TOP(BLOCK_LEVEL)+1
|
||||
IX=SYMBOL_TOP(BLOCK_LEVEL)
|
||||
SYMBOL_PLM_ID(IX)=SYMBOL_PLM_ID(I)
|
||||
SYMBOL_VAX_ID(IX)=SYMBOL_VAX_ID(I)
|
||||
SYMBOL_KIND(IX)=SYMBOL_KIND(I)
|
||||
SYMBOL_TYPE(IX)=SYMBOL_TYPE(I)
|
||||
SYMBOL_NBR_ELEMENTS(IX)=SYMBOL_NBR_ELEMENTS(I)
|
||||
SYMBOL_ELEMENT_SIZE(IX)=SYMBOL_ELEMENT_SIZE(I)
|
||||
SYMBOL_LINK(IX)=SYMBOL_LINK(I)
|
||||
SYMBOL_LIST_SIZE(IX)=SYMBOL_LIST_SIZE(I)
|
||||
SYMBOL_REF(IX)=SYMBOL_REF(I)
|
||||
SYMBOL_BASE(IX)=SYMBOL_BASE(I)
|
||||
SYMBOL_BASE_MEMBER(IX)=SYMBOL_BASE_MEMBER(I)
|
||||
SYMBOL_FLAGS(IX)=SYMBOL_FLAGS(I)
|
||||
SYMBOL_SERIAL_NO(IX)=SYMBOL_SERIAL_NO(I)
|
||||
SYMBOL_PSECT(IX)=SYMBOL_PSECT(I)
|
||||
H=HASH(SYMBOL_PLM_ID(I))
|
||||
SYMBOL_CHAIN(IX)=HASH_BUCKET(H)
|
||||
HASH_BUCKET(H)=IX
|
||||
ENDIF
|
||||
40 CONTINUE
|
||||
RETURN
|
||||
END
|
||||
201
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/branches.for
Normal file
201
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/branches.for
Normal file
@@ -0,0 +1,201 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C BRANCHES.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler generates optimized
|
||||
C conditional branch code for short-circuit evaluation of
|
||||
C Boolean expressions.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 15OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 21OCT81 Alex Hunter 1. Use OP_BB opcode. (V5.6)
|
||||
C 2. Recode the BRANCH2 table.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE BRANCH_TO(NODX,TRUEX,FALSEX,FALL_THRUX)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
NOD=NODX
|
||||
TRUE=TRUEX
|
||||
FALSE=FALSEX
|
||||
FALL_THRU=FALL_THRUX
|
||||
|
||||
IF (NODE(NOD).AND.OPNODE_OP(NOD).EQ.OP_EXT) THEN
|
||||
|
||||
CALL GENERATE_LOCAL_LABEL(LL1)
|
||||
CALL PUSH(TRUE,1)
|
||||
CALL PUSH(FALSE,1)
|
||||
CALL PUSH(FALL_THRU,1)
|
||||
CALL PUSH(NOD,1)
|
||||
CALL PUSH(LL1,1)
|
||||
CALL BRANCH_TO2(OPNODE_OPND1(NOD),LL1,FALSE,LL1)
|
||||
CALL POP(LL1,1)
|
||||
CALL POP(NOD,1)
|
||||
CALL POP(FALL_THRU,1)
|
||||
CALL POP(FALSE,1)
|
||||
CALL POP(TRUE,1)
|
||||
CALL EMIT_LOCAL_LABEL(LL1)
|
||||
CALL BRANCH_TO2(OPNODE_OPND2(NOD),FALSE,TRUE,FALL_THRU)
|
||||
|
||||
ELSEIF (NODE(NOD).AND.OPNODE_OP(NOD).EQ.OP_OR) THEN
|
||||
|
||||
CALL GENERATE_LOCAL_LABEL(LL1)
|
||||
CALL PUSH(TRUE,1)
|
||||
CALL PUSH(FALSE,1)
|
||||
CALL PUSH(FALL_THRU,1)
|
||||
CALL PUSH(NOD,1)
|
||||
CALL PUSH(LL1,1)
|
||||
CALL BRANCH_TO2(OPNODE_OPND1(NOD),TRUE,LL1,LL1)
|
||||
CALL POP(LL1,1)
|
||||
CALL POP(NOD,1)
|
||||
CALL POP(FALL_THRU,1)
|
||||
CALL POP(FALSE,1)
|
||||
CALL POP(TRUE,1)
|
||||
CALL EMIT_LOCAL_LABEL(LL1)
|
||||
CALL BRANCH_TO2(OPNODE_OPND2(NOD),TRUE,FALSE,FALL_THRU)
|
||||
|
||||
ELSEIF (NODE(NOD).AND.OPNODE_OP(NOD).EQ.OP_NOT) THEN
|
||||
|
||||
CALL BRANCH_TO2(OPNODE_OPND1(NOD),FALSE,TRUE,FALL_THRU)
|
||||
|
||||
ELSEIF (NODE(NOD).AND.OPNODE_OP(NOD).GE.OP_LT.AND.
|
||||
# OPNODE_OP(NOD).LE.OP_GE) THEN
|
||||
|
||||
CALL PUSH(TRUE,1)
|
||||
CALL PUSH(FALSE,1)
|
||||
CALL PUSH(FALL_THRU,1)
|
||||
CALL PUSH(NOD,1)
|
||||
OPND1=GET_SOMEWHERE(OPNODE_OPND1(NOD),ANY_WHERE)
|
||||
CALL POP(NOD,1)
|
||||
CALL PUSH(NOD,1)
|
||||
CALL PUSH(OPND1,1)
|
||||
OPND2=GET_SOMEWHERE(OPNODE_OPND2(NOD),ANY_WHERE)
|
||||
CALL POP(OPND1,1)
|
||||
CALL POP(NOD,1)
|
||||
CALL POP(FALL_THRU,1)
|
||||
CALL POP(FALSE,1)
|
||||
CALL POP(TRUE,1)
|
||||
CALL EMIT_CODE(OPNODE_OP(NOD),OPND2,OPND1,NULL)
|
||||
CALL EMIT_BRANCH(OPNODE_OP(NOD),OPND1,TRUE,FALSE,FALL_THRU)
|
||||
|
||||
ELSE
|
||||
|
||||
CALL PUSH(TRUE,1)
|
||||
CALL PUSH(FALSE,1)
|
||||
CALL PUSH(FALL_THRU,1)
|
||||
CALL PUSH(NOD,1)
|
||||
TEST=GET_SOMEWHERE(NOD,ANY_WHERE)
|
||||
CALL POP(NOD,1)
|
||||
CALL POP(FALL_THRU,1)
|
||||
CALL POP(FALSE,1)
|
||||
CALL POP(TRUE,1)
|
||||
|
||||
IF (ATOM(TEST).AND.ATOM_SUB(TEST).NE.NULL.AND.
|
||||
# NODE_TYPE(TEST).EQ.S_BYTE) THEN
|
||||
|
||||
CALL EMIT_BRANCH(OP_BB,TEST,TRUE,FALSE,FALL_THRU)
|
||||
|
||||
ELSEIF (ATOM(TEST).AND.ATOM_SUB(TEST).NE.NULL.AND.
|
||||
# (NODE_TYPE(TEST).EQ.S_WORD.OR.
|
||||
# NODE_TYPE(TEST).EQ.S_INTEGER)) THEN
|
||||
|
||||
CALL EMIT_CODE(OP_BIT,NULL,MAKE_FIXED(1,NODE_TYPE(TEST)),
|
||||
# TEST)
|
||||
CALL EMIT_BRANCH(OP_BNE,NULL,TRUE,FALSE,FALL_THRU)
|
||||
ELSE
|
||||
CALL EMIT_BRANCH(OP_BLB,TEST,TRUE,FALSE,FALL_THRU)
|
||||
ENDIF
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE BRANCH_TO2(NODX,TRUEX,FALSEX,FALL_THRUX)
|
||||
IMPLICIT INTEGER*2 (A-Z)
|
||||
NOD=NODX
|
||||
TRUE=TRUEX
|
||||
FALSE=FALSEX
|
||||
FALL_THRU=FALL_THRUX
|
||||
CALL BRANCH_TO(NOD,TRUE,FALSE,FALL_THRU)
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE EMIT_BRANCH(OP,OPND,TRUE,FALSE,FALL_THRU)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*80 OPERAND,OPERAND1
|
||||
CHARACTER*6 BR
|
||||
CHARACTER*32 LABEL
|
||||
CHARACTER*6 BRANCH1(1:2,OP_BNE:OP_BB)
|
||||
DATA BRANCH1/
|
||||
# 'BNEQ ','BEQL ',
|
||||
# 'BLBS ','BLBC ',
|
||||
# 'BBS ','BBC '/
|
||||
CHARACTER*6 BRANCH2(CX_UNSIGNED:CX_SIGNED,1:2,OP_LT:OP_GE)
|
||||
DATA BRANCH2/
|
||||
# 'BLSSU','BLSS ',
|
||||
# 'BGEQU','BGEQ ',
|
||||
# 'BGTRU','BGTR ',
|
||||
# 'BLEQU','BLEQ ',
|
||||
# 'BEQLU','BEQL ',
|
||||
# 'BNEQU','BNEQ ',
|
||||
# 'BNEQU','BNEQ ',
|
||||
# 'BEQLU','BEQL ',
|
||||
# 'BLEQU','BLEQ ',
|
||||
# 'BGTRU','BGTR ',
|
||||
# 'BGEQU','BGEQ ',
|
||||
# 'BLSSU','BLSS '/
|
||||
|
||||
IF (FALL_THRU.EQ.FALSE) THEN
|
||||
BRANCH=TRUE
|
||||
TF=1
|
||||
ELSEIF (FALL_THRU.EQ.TRUE) THEN
|
||||
BRANCH=FALSE
|
||||
TF=2
|
||||
ELSE
|
||||
CALL BUG('EB-0')
|
||||
ENDIF
|
||||
|
||||
LABEL=LOCAL_LABEL(BRANCH,L1)
|
||||
|
||||
IF (OP.GE.OP_LT.AND.OP.LE.OP_GE) THEN
|
||||
BR=BRANCH2(CONTEXT(NODE_TYPE(OPND)),TF,OP)
|
||||
ELSE
|
||||
BR=BRANCH1(TF,OP)
|
||||
ENDIF
|
||||
|
||||
IF (OP.EQ.OP_BLB) THEN
|
||||
OPERAND1=OPERAND(OPND,N1)
|
||||
CALL EMIT(BR//' '//OPERAND1(:N1)//','//LABEL(:L1))
|
||||
ELSEIF (OP.EQ.OP_BB) THEN
|
||||
OPERAND1=OPERAND(OPND,N1)
|
||||
CALL EMIT(BR//' #0,'//OPERAND1(:N1)//','//LABEL(:L1))
|
||||
ELSE
|
||||
CALL EMIT(BR//' '//LABEL(:L1))
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
53
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/break.for
Normal file
53
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/break.for
Normal file
@@ -0,0 +1,53 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C BREAK.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler handles breaks between
|
||||
C basic blocks.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 15OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 21OCT81 Alex Hunter 1. Basic block analysis. (V5.5)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE BREAK
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
CALL MASSAGE(BASIC_BLOCK,0)
|
||||
CALL GET_SOMEWHERE(BASIC_BLOCK,ANY_WHERE)
|
||||
BASIC_BLOCK=NULL
|
||||
END_OF_BASIC_BLOCK=.FALSE.
|
||||
NEXT_NODE=NODE_MIN
|
||||
NEXT_ATOM=FIRST_FREE_ATOM
|
||||
NEXT_FIXED=FIX_MIN
|
||||
NEXT_FLOAT=FLT_MIN
|
||||
NEXT_CONSTANT=CON_MIN
|
||||
CALL FREE_REGS
|
||||
RETURN
|
||||
END
|
||||
218
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/builtins.for
Normal file
218
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/builtins.for
Normal file
@@ -0,0 +1,218 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C BUILTINS.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler handles those built-in
|
||||
C functions which potentially generate in-line code.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 29SEP81 Alex Hunter 1. Implement the FIRST function. (V5.3)
|
||||
C 2. Allow LENGTH,FIRST,LAST,SIZE to be >64K.
|
||||
C 3. Choose correct value of SP for STACK$PTR.
|
||||
C 21OCT81 Alex Hunter 1. Implement %_signed and %_unsigned. (V5.5)
|
||||
C 10NOV81 Alex Hunter 1. Determine procedure side effects. (V6.0)
|
||||
C 12NOV81 Alex Hunter 1. Implement LAST(MEMORY), et al. (V6.1)
|
||||
C
|
||||
C***********************************************************************
|
||||
INTEGER*2 FUNCTION BUILTIN_FUNCTION(DPIX)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
INTEGER*4 LENGTH,SIZE,LOWER_BOUND
|
||||
COMMON /BUILTINS/ SYM_SUBS,MEM_SUBS
|
||||
|
||||
PIX=DPIX
|
||||
|
||||
IF (SYMBOL_PLM_ID(PIX).EQ.'LENGTH'.OR.
|
||||
# SYMBOL_PLM_ID(PIX).EQ.'FIRST'.OR.
|
||||
# SYMBOL_PLM_ID(PIX).EQ.'LAST') THEN
|
||||
|
||||
CALL MATCH(D_LP)
|
||||
|
||||
IF (TT.EQ.FIXCON.OR.TT.EQ.FLOATCON.OR.TT.EQ.STRCON) THEN
|
||||
LENGTH=1
|
||||
LOWER_BOUND=0
|
||||
CALL GETTOK
|
||||
ELSE
|
||||
CALL MUSTBE(ID)
|
||||
CALL LOOKUP_SYMBOL
|
||||
CALL PUSH(PIX,1)
|
||||
ARG=DATA_REFERENCE(0,.TRUE.)
|
||||
CALL POP(PIX,1)
|
||||
IF ((SYMBOL_FLAGS(SYMBOL_INDEX).AND.S_SPECIAL).NE.0.AND.
|
||||
# SYMBOL_PLM_ID(PIX).NE.'FIRST') THEN
|
||||
IF (SYMBOL_PLM_ID(SYMBOL_INDEX).EQ.'MEMORY') THEN
|
||||
IF (SYMBOL_PLM_ID(PIX).EQ.'LENGTH') THEN
|
||||
SYM=SYM_MLEN
|
||||
ELSE
|
||||
SYM=SYM_MLAST
|
||||
ENDIF
|
||||
ELSE
|
||||
IF (SYMBOL_PLM_ID(PIX).EQ.'LENGTH') THEN
|
||||
SYM=SYM_SLEN
|
||||
ELSE
|
||||
SYM=SYM_SLAST
|
||||
ENDIF
|
||||
ENDIF
|
||||
BUILTIN_FUNCTION=MAKE_ATOM(SYM,0,NULL,NULL,S_LONG,0,0)
|
||||
GO TO 10
|
||||
ELSEIF (MEMBER_INDEX.EQ.0) THEN
|
||||
IF (SYM_SUBS.EQ.NULL) THEN
|
||||
LENGTH=SYMBOL_NBR_ELEMENTS(SYMBOL_INDEX)
|
||||
LOWER_BOUND=SYMBOL_LOWER_BOUND(SYMBOL_INDEX)
|
||||
ELSE
|
||||
LENGTH=1
|
||||
LOWER_BOUND=0
|
||||
ENDIF
|
||||
ELSE
|
||||
IF (MEM_SUBS.EQ.NULL) THEN
|
||||
LENGTH=MEMBER_NBR_ELEMENTS(MEMBER_INDEX)
|
||||
LOWER_BOUND=MEMBER_LOWER_BOUND(MEMBER_INDEX)
|
||||
ELSE
|
||||
LENGTH=1
|
||||
LOWER_BOUND=0
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
IF (SYMBOL_PLM_ID(PIX).EQ.'LENGTH') THEN
|
||||
BUILTIN_FUNCTION=MAKE_FIXED(LENGTH,S_LONG)
|
||||
ELSEIF (SYMBOL_PLM_ID(PIX).EQ.'FIRST') THEN
|
||||
BUILTIN_FUNCTION=MAKE_FIXED(LOWER_BOUND,S_LONG)
|
||||
ELSE
|
||||
BUILTIN_FUNCTION=MAKE_FIXED(LOWER_BOUND+LENGTH-1,S_LONG)
|
||||
ENDIF
|
||||
|
||||
10 CALL MATCH(D_RP)
|
||||
|
||||
ELSEIF (SYMBOL_PLM_ID(PIX).EQ.'SIZE') THEN
|
||||
|
||||
CALL MATCH(D_LP)
|
||||
|
||||
IF (TT.EQ.FIXCON) THEN
|
||||
IF (FIXVAL.LE.255) THEN
|
||||
SIZE=1
|
||||
ELSEIF (FIXVAL.LE.'FFFF'X) THEN
|
||||
SIZE=2
|
||||
ELSE
|
||||
SIZE=4
|
||||
ENDIF
|
||||
CALL GETTOK
|
||||
ELSEIF (TT.EQ.FLOATCON) THEN
|
||||
SIZE=4
|
||||
CALL GETTOK
|
||||
ELSEIF (TT.EQ.STRCON) THEN
|
||||
SIZE=STRLEN
|
||||
CALL GETTOK
|
||||
ELSE
|
||||
CALL MUSTBE(ID)
|
||||
CALL LOOKUP_SYMBOL
|
||||
CALL PUSH(PIX,1)
|
||||
ARG=DATA_REFERENCE(0,.TRUE.)
|
||||
CALL POP(PIX,1)
|
||||
IF ((SYMBOL_FLAGS(SYMBOL_INDEX).AND.S_SPECIAL).NE.0) THEN
|
||||
IF (SYMBOL_PLM_ID(SYMBOL_INDEX).EQ.'MEMORY') THEN
|
||||
SYM=SYM_MSIZ
|
||||
ELSE
|
||||
SYM=SYM_SSIZ
|
||||
ENDIF
|
||||
BUILTIN_FUNCTION=MAKE_ATOM(SYM,0,NULL,NULL,S_LONG,0,0)
|
||||
GO TO 20
|
||||
ELSEIF (MEMBER_INDEX.EQ.0) THEN
|
||||
IF (SYM_SUBS.EQ.NULL) THEN
|
||||
SIZE=SYMBOL_NBR_ELEMENTS(SYMBOL_INDEX)
|
||||
SIZE=SIZE*SYMBOL_ELEMENT_SIZE(SYMBOL_INDEX)
|
||||
ELSE
|
||||
SIZE=SYMBOL_ELEMENT_SIZE(SYMBOL_INDEX)
|
||||
ENDIF
|
||||
ELSE
|
||||
IF (MEM_SUBS.EQ.NULL) THEN
|
||||
SIZE=MEMBER_NBR_ELEMENTS(MEMBER_INDEX)*
|
||||
# MEMBER_ELEMENT_SIZE(MEMBER_INDEX)
|
||||
ELSE
|
||||
SIZE=MEMBER_ELEMENT_SIZE(MEMBER_INDEX)
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
BUILTIN_FUNCTION=MAKE_FIXED(SIZE,S_LONG)
|
||||
|
||||
20 CALL MATCH(D_RP)
|
||||
|
||||
ELSEIF (SYMBOL_PLM_ID(PIX).EQ.'STACKPTR') THEN
|
||||
IF (MODEL.EQ.2 .OR. MODEL.EQ.4) THEN
|
||||
SP=14
|
||||
ELSE
|
||||
SP=10
|
||||
ENDIF
|
||||
BUILTIN_FUNCTION=MAKE_REGISTER(SP,S_PTR)
|
||||
|
||||
ELSEIF (SYMBOL_PLM_ID(PIX).EQ.'FRAMEPTR') THEN
|
||||
BUILTIN_FUNCTION=MAKE_REGISTER(13,S_PTR)
|
||||
|
||||
ELSEIF (SYMBOL_PLM_ID(PIX)(1:2).EQ.'$_' .OR.
|
||||
# SYMBOL_PLM_ID(PIX).EQ.'DOUBLE' .OR.
|
||||
# SYMBOL_PLM_ID(PIX).EQ.'LOW' .OR.
|
||||
# SYMBOL_PLM_ID(PIX).EQ.'FLOAT' .OR.
|
||||
# SYMBOL_PLM_ID(PIX).EQ.'FIX' .OR.
|
||||
# SYMBOL_PLM_ID(PIX).EQ.'INT' .OR.
|
||||
# SYMBOL_PLM_ID(PIX).EQ.'SIGNED' .OR.
|
||||
# SYMBOL_PLM_ID(PIX).EQ.'UNSIGN') THEN
|
||||
|
||||
CALL MATCH(D_LP)
|
||||
CALL PUSH(PIX,1)
|
||||
ARG=EXPRESSION(1)
|
||||
CALL POP(PIX,1)
|
||||
CALL MATCH(D_RP)
|
||||
|
||||
IF (SYMBOL_PLM_ID(PIX).EQ.'$_SIGNED') THEN
|
||||
BUILTIN_FUNCTION=MAKE_NODE(OP_SIGNED,ARG,NULL,0,0,0)
|
||||
ELSEIF (SYMBOL_PLM_ID(PIX).EQ.'$_UNSIGNED') THEN
|
||||
BUILTIN_FUNCTION=MAKE_NODE(OP_UNSIGNED,ARG,NULL,0,0,0)
|
||||
ELSE
|
||||
IF (SYMBOL_PLM_ID(PIX).EQ.'INT' .OR.
|
||||
# SYMBOL_PLM_ID(PIX).EQ.'SIGNED') THEN
|
||||
ARG=MAKE_NODE(OP_WORD,ARG,NULL,S_WORD,0,0)
|
||||
ELSEIF (SYMBOL_PLM_ID(PIX).EQ.'UNSIGN') THEN
|
||||
ARG=MAKE_NODE(OP_INTEGER,ARG,NULL,S_INTEGER,0,0)
|
||||
ENDIF
|
||||
BUILTIN_FUNCTION=MAKE_NODE(OP_BYTE+SYMBOL_TYPE(PIX)-S_BYTE,
|
||||
# ARG,NULL,SYMBOL_TYPE(PIX),0,0)
|
||||
ENDIF
|
||||
|
||||
ELSE
|
||||
|
||||
CALL ERROR('UNIMPLEMENTED BUILTIN FUNCTION: '//
|
||||
# SYMBOL_PLM_ID(PIX))
|
||||
BUILTIN_FUNCTION=NULL
|
||||
ENDIF
|
||||
|
||||
CALL DETERMINE_EFFECTS_OF_CALLING(PIX)
|
||||
|
||||
RETURN
|
||||
END
|
||||
372
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/coerce.for
Normal file
372
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/coerce.for
Normal file
@@ -0,0 +1,372 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C COERCE.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler coerces nodes of a code
|
||||
C tree to the proper type, according to the implicit type coercion
|
||||
C rules.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 15OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE COERCE_TYPES(NODX)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
INTEGER*2 CVT_TYPE(OP_B2W:OP_P2L)
|
||||
DATA CVT_TYPE/
|
||||
# S_WORD,S_INTEGER, S_LONG, S_REAL, S_BYTE,
|
||||
# S_LONG, S_BYTE, S_REAL, S_LONG, S_LONG,
|
||||
# S_INTEGER, S_WORD, S_REAL, S_BYTE, S_BYTE,
|
||||
# S_INTEGER, S_DOUBLE, S_QUAD, S_DOUBLE, S_BYTE,
|
||||
# S_INTEGER, S_REAL, S_LONG, S_LONG, S_DOUBLE,
|
||||
# S_PTR, S_LONG/
|
||||
INTEGER*2 MUL_TYPE(1:7,1:7)
|
||||
DATA MUL_TYPE
|
||||
// S_WORD,S_LONG,S_INTEGER,0,S_REAL,S_LONG,S_DOUBLE
|
||||
,, S_LONG,S_LONG,S_LONG,0,S_REAL,S_LONG,S_DOUBLE
|
||||
,, S_INTEGER,S_LONG,S_INTEGER,0,S_REAL,S_LONG,S_DOUBLE
|
||||
,, 0,0,0,0,0,0,0
|
||||
,, S_REAL,S_REAL,S_REAL,0,S_REAL,S_DOUBLE,S_DOUBLE
|
||||
,, S_LONG,S_LONG,S_LONG,0,S_DOUBLE,S_LONG,S_DOUBLE
|
||||
,, S_DOUBLE,S_DOUBLE,S_DOUBLE,0,S_DOUBLE,S_DOUBLE,S_DOUBLE
|
||||
//
|
||||
INTEGER*2 ADD_TYPE(1:7,1:7)
|
||||
DATA ADD_TYPE
|
||||
// S_BYTE,S_WORD,S_INTEGER,S_PTR,S_REAL,S_LONG,S_DOUBLE
|
||||
,, S_WORD,S_WORD,S_INTEGER,S_PTR,S_REAL,S_LONG,S_DOUBLE
|
||||
,, S_INTEGER,S_INTEGER,S_INTEGER,S_PTR,S_REAL,S_LONG,S_DOUBLE
|
||||
,, S_PTR,S_PTR,S_PTR,0,0,S_PTR,0
|
||||
,, S_REAL,S_REAL,S_REAL,0,S_REAL,S_DOUBLE,S_DOUBLE
|
||||
,, S_LONG,S_LONG,S_LONG,S_PTR,S_DOUBLE,S_LONG,S_DOUBLE
|
||||
,, S_DOUBLE,S_DOUBLE,S_DOUBLE,0,S_DOUBLE,S_DOUBLE,S_DOUBLE
|
||||
//
|
||||
INTEGER*2 OPND_TYPE(1:7,1:7)
|
||||
DATA OPND_TYPE
|
||||
// S_BYTE,S_WORD,S_INTEGER,S_PTR,S_REAL,S_LONG,S_DOUBLE
|
||||
,, S_WORD,S_WORD,S_INTEGER,S_PTR,S_REAL,S_LONG,S_DOUBLE
|
||||
,, S_INTEGER,S_INTEGER,S_INTEGER,S_PTR,S_REAL,S_LONG,S_DOUBLE
|
||||
,, S_LONG,S_LONG,S_LONG,0,0,S_LONG,0
|
||||
,, S_REAL,S_REAL,S_REAL,0,S_REAL,S_DOUBLE,S_DOUBLE
|
||||
,, S_LONG,S_LONG,S_LONG,S_PTR,S_DOUBLE,S_LONG,S_DOUBLE
|
||||
,, S_DOUBLE,S_DOUBLE,S_DOUBLE,0,S_DOUBLE,S_DOUBLE,S_DOUBLE
|
||||
//
|
||||
|
||||
NOD=NODX
|
||||
|
||||
IF (NOD.EQ.NULL) RETURN
|
||||
|
||||
IF (CONSTANT(NOD)) RETURN
|
||||
|
||||
IF (REGISTER(NOD)) RETURN
|
||||
|
||||
IF (FLOATLIT(NOD)) THEN
|
||||
RETURN
|
||||
|
||||
ELSEIF (FIXLIT(NOD)) THEN
|
||||
IF (NODE_TYPE(NOD).EQ.0) THEN
|
||||
IF (NODE_CONTEXT(NOD).EQ.CX_SIGNED) THEN
|
||||
NODE_TYPE(NOD)=S_INTEGER
|
||||
ELSEIF (FIXED_VAL(NOD).GE.0.AND.FIXED_VAL(NOD).LE.255) THEN
|
||||
NODE_TYPE(NOD)=S_BYTE
|
||||
ELSE
|
||||
NODE_TYPE(NOD)=S_WORD
|
||||
ENDIF
|
||||
ENDIF
|
||||
RETURN
|
||||
|
||||
ELSEIF (ATOM(NOD)) THEN
|
||||
|
||||
CALL PUSH(NOD,1)
|
||||
CALL COERCE_TYPES2(ATOM_BASE(NOD))
|
||||
CALL POP(NOD,1)
|
||||
ATOM_BASE(NOD)=FORCE_TYPE(ATOM_BASE(NOD),S_PTR)
|
||||
|
||||
CALL PUSH(NOD,1)
|
||||
CALL COERCE_TYPES2(ATOM_SUB(NOD))
|
||||
CALL POP(NOD,1)
|
||||
ATOM_SUB(NOD)=FORCE_TYPE(ATOM_SUB(NOD),S_LONG)
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
C ---- NODE IS AN OPNODE.
|
||||
|
||||
CALL PUSH(NOD,1)
|
||||
CALL COERCE_TYPES2(OPNODE_OPND1(NOD))
|
||||
CALL POP(NOD,1)
|
||||
|
||||
CALL PUSH(NOD,1)
|
||||
CALL COERCE_TYPES2(OPNODE_OPND2(NOD))
|
||||
CALL POP(NOD,1)
|
||||
|
||||
IF (OPNODE_OP(NOD).EQ.OP_ASSN.OR.OPNODE_OP(NOD).EQ.OP_MOV) THEN
|
||||
NODE_TYPE(NOD)=NODE_TYPE(OPNODE_OPND2(NOD))
|
||||
OPNODE_OPND1(NOD)=FORCE_TYPE(OPNODE_OPND1(NOD),NODE_TYPE(NOD))
|
||||
|
||||
ELSEIF (OPNODE_OP(NOD).EQ.OP_LOC) THEN
|
||||
NODE_TYPE(NOD)=S_PTR
|
||||
|
||||
ELSEIF (OPNODE_OP(NOD).GT.100) THEN
|
||||
NODE_TYPE(NOD)=CVT_TYPE(OPNODE_OP(NOD))
|
||||
|
||||
ELSEIF (OPNODE_OP(NOD).EQ.OP_CALL) THEN
|
||||
NODE_TYPE(NOD)=NODE_TYPE(OPNODE_OPND1(NOD))
|
||||
|
||||
ELSEIF (OPNODE_OP(NOD).EQ.OP_ARG) THEN
|
||||
IF (BYTE_SIZE(NODE_TYPE(OPNODE_OPND2(NOD))).EQ.4) THEN
|
||||
NODE_TYPE(NOD)=NODE_TYPE(OPNODE_OPND2(NOD))
|
||||
ELSE
|
||||
NODE_TYPE(NOD)=S_LONG
|
||||
OPNODE_OPND2(NOD)=FORCE_TYPE(OPNODE_OPND2(NOD),S_LONG)
|
||||
ENDIF
|
||||
|
||||
ELSEIF (OPNODE_OP(NOD).GT.80.AND.OPNODE_OP(NOD).LT.100) THEN
|
||||
NODE_TYPE(NOD)=OPNODE_OP(NOD)-80
|
||||
OPNODE_OPND1(NOD)=FORCE_TYPE(OPNODE_OPND1(NOD),NODE_TYPE(NOD))
|
||||
OPNODE_OP(NOD)=OP_NOP
|
||||
|
||||
ELSEIF (OPNODE_OP(NOD).EQ.OP_THEN.OR.OPNODE_OP(NOD).EQ.OP_ALSO)
|
||||
# THEN
|
||||
RETURN
|
||||
|
||||
ELSEIF (OPNODE_OPND2(NOD).EQ.NULL) THEN
|
||||
NODE_TYPE(NOD)=NODE_TYPE(OPNODE_OPND1(NOD))
|
||||
|
||||
ELSE
|
||||
IF (OPNODE_OP(NOD).EQ.OP_MUL.OR.OPNODE_OP(NOD).EQ.OP_DIV) THEN
|
||||
NODE_TYPE(NOD)=MUL_TYPE(NODE_TYPE(OPNODE_OPND1(NOD)),
|
||||
# NODE_TYPE(OPNODE_OPND2(NOD)))
|
||||
OPND1_TYPE=NODE_TYPE(NOD)
|
||||
OPND2_TYPE=NODE_TYPE(NOD)
|
||||
ELSEIF (OPNODE_OP(NOD).EQ.OP_ADWC.OR.OPNODE_OP(NOD).EQ.OP_SBWC)
|
||||
# THEN
|
||||
NODE_TYPE(NOD)=S_LONG
|
||||
OPND1_TYPE=S_LONG
|
||||
OPND2_TYPE=S_LONG
|
||||
ELSEIF (OPNODE_OP(NOD).EQ.OP_MOD) THEN
|
||||
NODE_TYPE(NOD)=S_LONG
|
||||
OPND1_TYPE=S_QUAD
|
||||
OPND2_TYPE=S_LONG
|
||||
ELSE
|
||||
NODE_TYPE(NOD)=ADD_TYPE(NODE_TYPE(OPNODE_OPND1(NOD)),
|
||||
# NODE_TYPE(OPNODE_OPND2(NOD)))
|
||||
OPND1_TYPE=OPND_TYPE(NODE_TYPE(OPNODE_OPND1(NOD)),
|
||||
# NODE_TYPE(OPNODE_OPND2(NOD)))
|
||||
OPND2_TYPE=OPND_TYPE(NODE_TYPE(OPNODE_OPND2(NOD)),
|
||||
# NODE_TYPE(OPNODE_OPND1(NOD)))
|
||||
ENDIF
|
||||
IF (NODE_TYPE(NOD).EQ.0) THEN
|
||||
CALL WARN('ILLEGAL MIXING OF TYPES')
|
||||
NODE_TYPE(NOD)=NODE_TYPE(OPNODE_OPND1(NOD))
|
||||
OPND1_TYPE=NODE_TYPE(OPNODE_OPND1(NOD))
|
||||
OPND2_TYPE=NODE_TYPE(OPNODE_OPND2(NOD))
|
||||
ENDIF
|
||||
OPNODE_OPND1(NOD)=FORCE_TYPE(OPNODE_OPND1(NOD),OPND1_TYPE)
|
||||
OPNODE_OPND2(NOD)=FORCE_TYPE(OPNODE_OPND2(NOD),OPND2_TYPE)
|
||||
IF (OPNODE_OP(NOD).GE.OP_LT.AND.OPNODE_OP(NOD).LE.OP_GE) THEN
|
||||
NODE_TYPE(NOD)=S_BYTE
|
||||
ELSEIF (OPNODE_OP(NOD).EQ.OP_AND) THEN
|
||||
OPNODE_OP(NOD)=OP_EXT
|
||||
NEW_OPND2=MAKE_NODE(OP_NOT,OPNODE_OPND2(NOD),NULL,0,0,0)
|
||||
NODE_TYPE(NEW_OPND2)=OPND2_TYPE
|
||||
NODE_CONTEXT(NEW_OPND2)=NODE_CONTEXT(OPNODE_OPND2(NOD))
|
||||
OPNODE_OPND2(NOD)=NEW_OPND2
|
||||
ENDIF
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE COERCE_TYPES2(NODX)
|
||||
CALL COERCE_TYPES(NODX)
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*2 FUNCTION FORCE_TYPE(NODX,TYPEX)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
NOD=NODX
|
||||
TYPE=TYPEX
|
||||
|
||||
IF (NOD.EQ.NULL.OR.NODE_TYPE(NOD).EQ.TYPE) THEN
|
||||
FORCE_TYPE=NOD
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
GOTO (1000,2000,3000,4000,5000,6000,70000,80000), NODE_TYPE(NOD)
|
||||
CALL BUG('FT-0')
|
||||
|
||||
1000 GOTO (9000,1200,1300,1400,1500,1600,1700,1800), TYPE
|
||||
CALL BUG('FT-1')
|
||||
1200 OP=OP_B2W
|
||||
GOTO 8000
|
||||
1300 OP=OP_B2I
|
||||
GOTO 8000
|
||||
1400 OP1=OP_B2L
|
||||
OP2=OP_L2P
|
||||
GOTO 7000
|
||||
1500 OP1=OP_B2L
|
||||
OP2=OP_L2R
|
||||
GOTO 7000
|
||||
1600 OP=OP_B2L
|
||||
GOTO 8000
|
||||
1700 OP1=OP_B2L
|
||||
OP2=OP_L2D
|
||||
GO TO 7000
|
||||
1800 OP1=OP_B2L
|
||||
OP2=OP_L2Q
|
||||
GO TO 7000
|
||||
|
||||
2000 GOTO (2100,9000,9000,2400,2500,2600,2700,2800), TYPE
|
||||
CALL BUG('FT-2')
|
||||
2100 OP=OP_W2B
|
||||
GOTO 8000
|
||||
2400 OP1=OP_W2L
|
||||
OP2=OP_L2P
|
||||
GOTO 7000
|
||||
2500 OP1=OP_W2L
|
||||
OP2=OP_L2R
|
||||
GOTO 7000
|
||||
2600 OP=OP_W2L
|
||||
GOTO 8000
|
||||
2700 OP1=OP_W2L
|
||||
OP2=OP_L2D
|
||||
GO TO 7000
|
||||
2800 OP1=OP_W2L
|
||||
OP2=OP_L2Q
|
||||
GO TO 7000
|
||||
|
||||
3000 GOTO (3100,9000,9000,3400,3500,3600,3700,3800), TYPE
|
||||
CALL BUG('FT-3')
|
||||
3100 OP=OP_I2B
|
||||
GOTO 8000
|
||||
3400 OP1=OP_I2L
|
||||
OP2=OP_L2P
|
||||
GOTO 7000
|
||||
3500 OP=OP_I2R
|
||||
GOTO 8000
|
||||
3600 OP=OP_I2L
|
||||
GOTO 8000
|
||||
3700 OP=OP_I2D
|
||||
GO TO 8000
|
||||
3800 OP1=OP_I2L
|
||||
OP2=OP_L2Q
|
||||
GO TO 7000
|
||||
|
||||
4000 GOTO (4100,4200,4300,9000,8500,4600,8500,4800), TYPE
|
||||
CALL BUG('FT-4')
|
||||
4100 OP1=OP_P2L
|
||||
OP2=OP_L2B
|
||||
GOTO 7000
|
||||
4200 CONTINUE
|
||||
4300 OP1=OP_P2L
|
||||
OP2=OP_L2W
|
||||
GOTO 7000
|
||||
4600 OP=OP_P2L
|
||||
GOTO 8000
|
||||
4800 OP1=OP_P2L
|
||||
OP2=OP_L2Q
|
||||
GOTO 7000
|
||||
|
||||
5000 GOTO (5100,5200,5300,8500,9000,5600,5700,5800), TYPE
|
||||
CALL BUG('FT-5')
|
||||
5100 OP=OP_R2B
|
||||
GOTO 8000
|
||||
5200 OP=OP_R2W
|
||||
GOTO 8000
|
||||
5300 OP=OP_R2I
|
||||
GOTO 8000
|
||||
5600 OP=OP_R2L
|
||||
GOTO 8000
|
||||
5700 OP=OP_R2D
|
||||
GO TO 8000
|
||||
5800 OP1=OP_R2L
|
||||
OP2=OP_L2Q
|
||||
GO TO 7000
|
||||
|
||||
6000 GOTO (6100,6200,6300,6400,6500,9000,6700,6800), TYPE
|
||||
CALL BUG('FT-6')
|
||||
6100 OP=OP_L2B
|
||||
GOTO 8000
|
||||
6200 CONTINUE
|
||||
6300 OP=OP_L2W
|
||||
GOTO 8000
|
||||
6400 OP=OP_L2P
|
||||
GOTO 8000
|
||||
6500 OP=OP_L2R
|
||||
GOTO 8000
|
||||
6700 OP=OP_L2D
|
||||
GO TO 8000
|
||||
6800 OP=OP_L2Q
|
||||
GO TO 8000
|
||||
|
||||
70000 GOTO (71000,72000,73000,8500,75000,76000,9000,78000), TYPE
|
||||
CALL BUG('FT-7')
|
||||
71000 OP=OP_D2B
|
||||
GOTO 8000
|
||||
72000 OP=OP_D2I
|
||||
GO TO 8000
|
||||
73000 OP=OP_D2I
|
||||
GO TO 8000
|
||||
75000 OP=OP_D2R
|
||||
GO TO 8000
|
||||
76000 OP=OP_D2L
|
||||
GO TO 8000
|
||||
78000 OP1=OP_D2L
|
||||
OP2=OP_L2Q
|
||||
GO TO 8000
|
||||
|
||||
80000 GOTO (81000,82000,83000,84000,85000,86000,87000,9000), TYPE
|
||||
CALL BUG('FT-8')
|
||||
81000 OP2=OP_L2B
|
||||
GO TO 80999
|
||||
82000 CONTINUE
|
||||
83000 OP2=OP_L2W
|
||||
GO TO 80999
|
||||
84000 OP2=OP_L2P
|
||||
GO TO 80999
|
||||
85000 OP2=OP_L2R
|
||||
GO TO 80999
|
||||
86000 OP=OP_Q2L
|
||||
GO TO 8000
|
||||
87000 OP2=OP_L2D
|
||||
80999 OP1=OP_Q2L
|
||||
GO TO 7000
|
||||
|
||||
7000 FORCE_TYPE=MAKE_NODE(OP2,MAKE_NODE(OP1,NOD,NULL,S_LONG,0,0),
|
||||
# NULL,TYPE,0,0)
|
||||
RETURN
|
||||
|
||||
8000 FORCE_TYPE=MAKE_NODE(OP,NOD,NULL,TYPE,0,0)
|
||||
RETURN
|
||||
|
||||
8500 CALL WARN('ILLEGAL TYPE CONVERSION')
|
||||
|
||||
9000 NODE_TYPE(NOD)=TYPE
|
||||
FORCE_TYPE=NOD
|
||||
RETURN
|
||||
END
|
||||
12
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/comlist.com
Normal file
12
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/comlist.com
Normal file
@@ -0,0 +1,12 @@
|
||||
$SET VERIFY
|
||||
$!
|
||||
$! COMLIST.COM
|
||||
$!
|
||||
$! Command file to produce short listings for the PL/M-VAX
|
||||
$! compiler.
|
||||
$!
|
||||
$! 02FEB82 Alex Hunter 1. Original version.
|
||||
$!
|
||||
$PRI/HEAD *.FOR
|
||||
$PRI CONTROL
|
||||
$SET NOVERIFY
|
||||
148
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/context.for
Normal file
148
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/context.for
Normal file
@@ -0,0 +1,148 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C CONTEXT.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler resolves the signed/unsigned
|
||||
C context for all the nodes of a code tree, and performs any implicit
|
||||
C context coercions required.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 15OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 21OCT81 Alex Hunter 1. Add OP_SIGNED and OP_UNSIGNED. (V5.5)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE RESOLVE_CONTEXT(NODX)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
NOD=NODX
|
||||
|
||||
IF (NOD.EQ.NULL) RETURN
|
||||
IF (CONSTANT(NOD)) RETURN
|
||||
IF (LITERAL(NOD)) RETURN
|
||||
IF (REGISTER(NOD)) RETURN
|
||||
|
||||
IF (ATOM(NOD)) THEN
|
||||
CALL PUSH(NOD,1)
|
||||
CALL RESOLVE_CONTEXT2(ATOM_BASE(NOD))
|
||||
CALL POP(NOD,1)
|
||||
IF (NODE_CONTEXT(ATOM_BASE(NOD)).EQ.0)
|
||||
# CALL SET_CONTEXT(ATOM_BASE(NOD),CX_UNSIGNED)
|
||||
CALL PUSH(NOD,1)
|
||||
CALL RESOLVE_CONTEXT2(ATOM_SUB(NOD))
|
||||
CALL POP(NOD,1)
|
||||
IF (NODE_CONTEXT(ATOM_SUB(NOD)).EQ.0)
|
||||
# CALL SET_CONTEXT(ATOM_SUB(NOD),CX_UNSIGNED)
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
CALL PUSH(NOD,1)
|
||||
CALL RESOLVE_CONTEXT2(OPNODE_OPND1(NOD))
|
||||
CALL POP(NOD,1)
|
||||
CALL PUSH(NOD,1)
|
||||
CALL RESOLVE_CONTEXT2(OPNODE_OPND2(NOD))
|
||||
CALL POP(NOD,1)
|
||||
|
||||
IF (OPNODE_OPND1(NOD).EQ.NULL) THEN
|
||||
NODE_CONTEXT(NOD)=NODE_CONTEXT(OPNODE_OPND2(NOD))
|
||||
RETURN
|
||||
|
||||
ELSEIF (OPNODE_OP(NOD).GT.80.AND.OPNODE_OP(NOD).LT.100) THEN
|
||||
NODE_CONTEXT(NOD)=CONTEXT(OPNODE_OP(NOD)-80)
|
||||
IF (NODE_CONTEXT(OPNODE_OPND1(NOD)).EQ.0) THEN
|
||||
CALL SET_CONTEXT(OPNODE_OPND1(NOD),NODE_CONTEXT(NOD))
|
||||
ENDIF
|
||||
RETURN
|
||||
|
||||
ELSEIF (OPNODE_OP(NOD).EQ.OP_SIGNED) THEN
|
||||
NODE_CONTEXT(NOD)=CX_SIGNED
|
||||
IF (NODE_CONTEXT(OPNODE_OPND1(NOD)).EQ.0) THEN
|
||||
CALL SET_CONTEXT(OPNODE_OPND1(NOD),CX_SIGNED)
|
||||
ENDIF
|
||||
OPNODE_OP(NOD)=OP_NOP
|
||||
|
||||
ELSEIF (OPNODE_OP(NOD).EQ.OP_UNSIGNED) THEN
|
||||
NODE_CONTEXT(NOD)=CX_UNSIGNED
|
||||
IF (NODE_CONTEXT(OPNODE_OPND1(NOD)).EQ.0) THEN
|
||||
CALL SET_CONTEXT(OPNODE_OPND1(NOD),CX_UNSIGNED)
|
||||
ENDIF
|
||||
OPNODE_OP(NOD)=OP_NOP
|
||||
|
||||
ELSEIF (OPNODE_OPND2(NOD).EQ.NULL.OR.OPNODE_OP(NOD).EQ.OP_CALL)
|
||||
# THEN
|
||||
NODE_CONTEXT(NOD)=NODE_CONTEXT(OPNODE_OPND1(NOD))
|
||||
RETURN
|
||||
|
||||
ELSEIF (OPNODE_OP(NOD).EQ.OP_ARG) THEN
|
||||
IF (NODE_CONTEXT(OPNODE_OPND2(NOD)).EQ.0) THEN
|
||||
CALL SET_CONTEXT(OPNODE_OPND2(NOD),CX_SIGNED) !DEBATABLE.
|
||||
ENDIF
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
IF (NODE_CONTEXT(OPNODE_OPND1(NOD)).EQ.0) THEN
|
||||
NODE_CONTEXT(NOD)=NODE_CONTEXT(OPNODE_OPND2(NOD))
|
||||
ELSE
|
||||
NODE_CONTEXT(NOD)=NODE_CONTEXT(OPNODE_OPND1(NOD))
|
||||
ENDIF
|
||||
|
||||
IF (NODE_CONTEXT(NOD).EQ.0) RETURN
|
||||
|
||||
IF (NODE_CONTEXT(OPNODE_OPND1(NOD)).EQ.0) THEN
|
||||
CALL SET_CONTEXT(OPNODE_OPND1(NOD),NODE_CONTEXT(NOD))
|
||||
ELSEIF (NODE_CONTEXT(OPNODE_OPND2(NOD)).EQ.0) THEN
|
||||
CALL SET_CONTEXT(OPNODE_OPND2(NOD),NODE_CONTEXT(NOD))
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
C--------------------------------------------------------------
|
||||
SUBROUTINE RESOLVE_CONTEXT2(NODX)
|
||||
CALL RESOLVE_CONTEXT(NODX)
|
||||
RETURN
|
||||
END
|
||||
C--------------------------------------------------------------
|
||||
SUBROUTINE SET_CONTEXT(NODX,CNTXTX)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
NOD=NODX
|
||||
CNTXT=CNTXTX
|
||||
|
||||
10 IF (NOD.EQ.NULL) RETURN
|
||||
NODE_CONTEXT(NOD)=CNTXT
|
||||
IF (.NOT. NODE(NOD)) RETURN
|
||||
CALL PUSH(NOD,1)
|
||||
CALL SET_CONTEXT2(OPNODE_OPND1(NOD),CNTXT)
|
||||
CALL POP(NOD,1)
|
||||
NOD=OPNODE_OPND2(NOD)
|
||||
GO TO 10
|
||||
END
|
||||
C--------------------------------------------------------------
|
||||
SUBROUTINE SET_CONTEXT2(NODX,CNTXTX)
|
||||
CALL SET_CONTEXT(NODX,CNTXTX)
|
||||
RETURN
|
||||
END
|
||||
1093
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/control.plm
Normal file
1093
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/control.plm
Normal file
File diff suppressed because it is too large
Load Diff
2687
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/control.tmp
Normal file
2687
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/control.tmp
Normal file
File diff suppressed because it is too large
Load Diff
150
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/counts.for
Normal file
150
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/counts.for
Normal file
@@ -0,0 +1,150 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C COUNTS.FOR
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler computes reference counts
|
||||
C for the nodes of a code tree.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 08SEP81 Alex Hunter 1. Written. (V5.1)
|
||||
C 28SEP81 Alex Hunter 2. STACKPTR caused CRC-0 bug. (V5.3)
|
||||
C 15OCT81 Alex Hunter 1. Experimental version. (V5.4)
|
||||
C 23OCT81 Alex Hunter 1. Compute correct reference counts for
|
||||
C operand 1 of OP_LOC and LHS of OP_MOV
|
||||
C and OP_ASSN. (V5.6)
|
||||
C 10NOV81 Alex Hunter 1. Implement DBG assumption. (V6.0)
|
||||
C 08FEB82 Alex Hunter 1. Correct count for merged ARG opnodes. (V6.7)
|
||||
C
|
||||
C***********************************************************************
|
||||
SUBROUTINE COMPUTE_REFERENCE_COUNTS (NODX)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
NOD = NODX ! Call by value.
|
||||
|
||||
IF (NOD.EQ.NULL .OR. REGISTER(NOD)) THEN
|
||||
RETURN
|
||||
|
||||
ELSEIF (LITERAL(NOD) .OR. CONSTANT(NOD)) THEN
|
||||
NODE_REFCT(NOD) = NODE_REFCT(NOD) + 1
|
||||
|
||||
ELSEIF (ATOM(NOD)) THEN
|
||||
NODE_REFCT(NOD) = NODE_REFCT(NOD) + 1
|
||||
CALL PUSH(NOD,1)
|
||||
CALL COMPUTE_REFERENCE_COUNTS2 (ATOM_BASE(NOD))
|
||||
CALL POP(NOD,1)
|
||||
CALL PUSH(NOD,1)
|
||||
CALL COMPUTE_REFERENCE_COUNTS2 (ATOM_SUB(NOD))
|
||||
CALL POP(NOD,1)
|
||||
|
||||
ELSEIF (NODE(NOD)) THEN
|
||||
NODE_REFCT(NOD) = NODE_REFCT(NOD) + 1
|
||||
IF (NODE_REFCT(NOD).EQ.1.OR.OPNODE_OP(NOD).EQ.OP_ARG) THEN
|
||||
CALL PUSH(NOD,1)
|
||||
IF (OPNODE_OP(NOD).EQ.OP_LOC) THEN
|
||||
CALL COMPUTE_ATOM_REFERENCE_COUNTS (OPNODE_OPND1(NOD))
|
||||
ELSE
|
||||
CALL COMPUTE_REFERENCE_COUNTS2 (OPNODE_OPND1(NOD))
|
||||
ENDIF
|
||||
CALL POP(NOD,1)
|
||||
CALL PUSH(NOD,1)
|
||||
IF (OPNODE_OP(NOD).EQ.OP_MOV .OR. OPNODE_OP(NOD).EQ.OP_ASSN)
|
||||
# THEN
|
||||
CALL COMPUTE_ATOM_REFERENCE_COUNTS (OPNODE_OPND2(NOD))
|
||||
ELSE
|
||||
CALL COMPUTE_REFERENCE_COUNTS2 (OPNODE_OPND2(NOD))
|
||||
ENDIF
|
||||
CALL POP(NOD,1)
|
||||
ENDIF
|
||||
|
||||
ELSE
|
||||
CALL BUG ('CRC-0 -- Invalid kind of node.')
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE COMPUTE_REFERENCE_COUNTS2 (NODX)
|
||||
IMPLICIT INTEGER*2 (A-Z)
|
||||
|
||||
CALL COMPUTE_REFERENCE_COUNTS (NODX)
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE COMPUTE_ATOM_REFERENCE_COUNTS (NODX)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
NOD = NODX ! Call by value.
|
||||
|
||||
IF (ATOM(NOD)) THEN
|
||||
CALL PUSH(NOD,1)
|
||||
CALL COMPUTE_REFERENCE_COUNTS (ATOM_BASE(NOD))
|
||||
CALL POP(NOD,1)
|
||||
CALL PUSH(NOD,1)
|
||||
CALL COMPUTE_REFERENCE_COUNTS (ATOM_SUB(NOD))
|
||||
CALL POP(NOD,1)
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE DECREMENT_VALUE_COUNTS (NODX)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
NOD = NODX ! Call by value.
|
||||
|
||||
CALL DECREMENT_REFERENCE_COUNTS(NOD)
|
||||
|
||||
IF (ATOM(NOD)) THEN
|
||||
CALL DECREMENT_REFERENCE_COUNTS(ATOM_BASE(NOD))
|
||||
CALL DECREMENT_REFERENCE_COUNTS(ATOM_SUB(NOD))
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE DECREMENT_REFERENCE_COUNTS (NODX)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
NOD = NODX ! Call by value.
|
||||
|
||||
IF (NOD.EQ.NULL .OR. REGISTER(NOD)) RETURN
|
||||
|
||||
NODE_REFCT(NOD) = NODE_REFCT(NOD) - 1
|
||||
|
||||
IF (ASSUME_DBG) WRITE(OUT,1001) NOD, NODE_REFCT(NOD)
|
||||
1001 FORMAT(' ;*DRC* nod',I6,' refct decremented to',I6)
|
||||
|
||||
IF (NODE_REFCT(NOD).EQ.-1) THEN
|
||||
CALL BUG('DRC -- Node reference count decremented to -1.')
|
||||
ENDIF
|
||||
|
||||
IF (NODE_REFCT(NOD).EQ.0 .AND. NODE_REG(NOD).NE.0) THEN
|
||||
IF (ASSUME_DBG) WRITE(OUT,1002) NODE_REG(NOD)
|
||||
1002 FORMAT(' ;*DRC* register ',I2,' can be reused...')
|
||||
CALL FREE_REG(NODE_REG(NOD))
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
177
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/data.for
Normal file
177
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/data.for
Normal file
@@ -0,0 +1,177 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C DATA.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler handles the INITIAL and
|
||||
C DATA attributes of a declaration.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 29SEP81 Alex Hunter 1. Allow DATA attribute with EXTERNAL. (V5.3)
|
||||
C 14NOV81 Alex Hunter 1. Change psect if constant data is to be
|
||||
C placed in $PLM_ROM. (V6.2)
|
||||
C
|
||||
C***********************************************************************
|
||||
SUBROUTINE INITIALIZATION(REF,THIS_PSECT)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
INTEGER*4 BLOCK_SIZE
|
||||
LOGICAL*2 NO_MORE_DATA,STRINGLEFT
|
||||
COMMON /INITDATA/ NO_MORE_DATA,STRINGLEFT,BLOCK_SIZE
|
||||
|
||||
IF ((ROM_FLAG.OR.MODEL.EQ.4).AND.TT.EQ.K_DATA) THEN
|
||||
THIS_PSECT=P_CONSTANTS ! Place data in $PLM_ROM.
|
||||
ENDIF
|
||||
|
||||
IF (REF.EQ.S_EXT .AND. TT.EQ.K_DATA) THEN
|
||||
CALL GETTOK
|
||||
NO_MORE_DATA=.TRUE.
|
||||
|
||||
ELSEIF (TT.EQ.K_INITIAL.OR.TT.EQ.K_DATA) THEN
|
||||
|
||||
CALL GETTOK
|
||||
CALL MATCH(D_LP)
|
||||
NO_MORE_DATA=.FALSE.
|
||||
STRINGLEFT=.FALSE.
|
||||
|
||||
ELSE
|
||||
NO_MORE_DATA=.TRUE.
|
||||
ENDIF
|
||||
|
||||
RETURN
|
||||
|
||||
C--------------------------------
|
||||
ENTRY POST_INITIALIZATION
|
||||
C--------------------------------
|
||||
|
||||
IF (NO_MORE_DATA) RETURN
|
||||
|
||||
CALL ERROR('TOO MUCH DATA IN INITIALIZATION LIST')
|
||||
|
||||
10 CALL INITIAL_DATA(S_WORD)
|
||||
IF (.NOT.NO_MORE_DATA) GO TO 10
|
||||
|
||||
RETURN
|
||||
END
|
||||
C------------------------------------------------------------------
|
||||
SUBROUTINE INITIAL_DATA(TYPE)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
INTEGER*4 BLOCK_SIZE
|
||||
LOGICAL*2 NO_MORE_DATA,STRINGLEFT
|
||||
COMMON /INITDATA/ NO_MORE_DATA,STRINGLEFT,BLOCK_SIZE
|
||||
CHARACTER*300 STRING1
|
||||
COMMON /FLUSH_A/ S_INDEX,S_NEXT
|
||||
COMMON /FLUSH_AC/ STRING1
|
||||
CHARACTER*80 OPERAND,OPERAND1,RESTRICTED_LOCATION_REFERENCE
|
||||
CHARACTER*7 DATA_POP(S_BYTE:S_QUAD)
|
||||
DATA DATA_POP
|
||||
// '.BYTE','.WORD','.WORD','.LONG','.FLOAT','.LONG','.DOUBLE'
|
||||
,, '.QUAD'
|
||||
//
|
||||
|
||||
BS = BYTE_SIZE(TYPE)
|
||||
|
||||
IF (NO_MORE_DATA) THEN
|
||||
BLOCK_SIZE=BLOCK_SIZE+BS
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
IF (STRINGLEFT.OR.TT.EQ.STRCON) THEN
|
||||
|
||||
IF (.NOT.STRINGLEFT) THEN
|
||||
STRING1=STRING
|
||||
S_INDEX=1
|
||||
S_NEXT=1
|
||||
S_LENGTH=STRLEN
|
||||
STRINGLEFT=.TRUE.
|
||||
ENDIF
|
||||
|
||||
S_NEXT=S_NEXT+BS
|
||||
|
||||
IF (S_NEXT-S_INDEX.GE.32) CALL FLUSH_ASCII
|
||||
IF (S_NEXT.LE.S_LENGTH) RETURN
|
||||
CALL FLUSH_ASCII
|
||||
STRINGLEFT=.FALSE.
|
||||
CALL GETTOK
|
||||
|
||||
ELSE
|
||||
|
||||
CALL BREAK
|
||||
CONST=EXPRESSION(0)
|
||||
CALL RESOLVE_CONTEXT(CONST)
|
||||
IF (NODE_CONTEXT(CONST).EQ.0)
|
||||
# CALL SET_CONTEXT(CONST,CONTEXT(TYPE))
|
||||
CALL COERCE_TYPES(CONST)
|
||||
CONST=FORCE_TYPE(CONST,TYPE)
|
||||
CONST=FOLD_CONSTANTS(CONST)
|
||||
|
||||
IF (NODE(CONST).AND.OPNODE_OP(CONST).GT.100.AND.
|
||||
# OPNODE_OP(CONST).LT.OP_L2P) THEN
|
||||
CONST=OPNODE_OPND1(CONST)
|
||||
ENDIF
|
||||
|
||||
IF (NODE(CONST).AND.OPNODE_OP(CONST).EQ.OP_LOC) THEN
|
||||
|
||||
OPERAND1=RESTRICTED_LOCATION_REFERENCE(CONST,N1)
|
||||
CALL EMIT(DATA_POP(TYPE)//' '//OPERAND1(:N1))
|
||||
|
||||
ELSEIF (LITERAL(CONST)) THEN
|
||||
|
||||
OPERAND1=OPERAND(CONST,N1)
|
||||
CALL EMIT(DATA_POP(TYPE)//' '//OPERAND1(2:N1))
|
||||
|
||||
ELSE
|
||||
|
||||
CALL ERROR('INITIALIZATION LIST ELEMENT NOT A CONSTANT')
|
||||
CALL EMIT(DATA_POP(TYPE)//' 0')
|
||||
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
IF (TT.EQ.D_COMMA) THEN
|
||||
CALL GETTOK
|
||||
IF (TT.NE.D_RP) RETURN ! ALLOW ',)' AT END OF LIST.
|
||||
ENDIF
|
||||
|
||||
CALL MATCH(D_RP)
|
||||
NO_MORE_DATA=.TRUE.
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------
|
||||
SUBROUTINE FLUSH_ASCII
|
||||
IMPLICIT INTEGER*2 (A-Z)
|
||||
CHARACTER*300 STRING1
|
||||
COMMON /FLUSH_A/ S_INDEX,S_NEXT
|
||||
COMMON /FLUSH_AC/ STRING1
|
||||
|
||||
IF (S_NEXT.GT.S_INDEX) THEN
|
||||
CALL EMIT('.ASCII `'//STRING1(S_INDEX:S_NEXT-1)//'`')
|
||||
S_INDEX=S_NEXT
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
687
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/decls.for
Normal file
687
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/decls.for
Normal file
@@ -0,0 +1,687 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C DECLS.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler processes declarations at
|
||||
C the beginning of a procedure or block.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 13SEP81 Alex Hunter 1. Implement ALIGN control. (V5.2)
|
||||
C 29SEP81 Alex Hunter 1. Change call to INITIALIZATION. (V5.3)
|
||||
C 2. Reduce macro body size by 1.
|
||||
C 3. Allow dimensions >64K.
|
||||
C 4. Allow structure member arrays to have
|
||||
C explicit lower bounds.
|
||||
C 21OCT81 Alex Hunter 1. Set S_OVERLAID attribute properly. (V5.5)
|
||||
C 28OCT81 Alex Hunter 1. Allow keywords to be re-declared. (V5.7)
|
||||
C 12NOV81 Alex Hunter 1. Implement psect numbers. (V6.1)
|
||||
C 2. Allow PUBLIC AT(.MEMORY).
|
||||
C 3. Allow AT(arg) and AT(dynamic).
|
||||
C 4. Allow structure array to be implicitly
|
||||
C dimensioned.
|
||||
C 14NOV81 Alex Hunter 1. Add this_psect arg to INITIALIZATION.
|
||||
C (V6.2)
|
||||
C 14JAN82 Alex Hunter 1. Fix minor bug from V5.7. (V6.5)
|
||||
C
|
||||
C***********************************************************************
|
||||
C --- Compile me with /NOCHECK please!!
|
||||
|
||||
SUBROUTINE DECLARATIONS
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
10 IF (TT.EQ.K_DECLARE) THEN
|
||||
CALL DECLARE_STATEMENT
|
||||
ELSEIF (TT.EQ.K_PROCEDURE) THEN
|
||||
CALL PROCEDURE_DEFINITION
|
||||
ELSEIF (TT.EQ.K_COMMON) THEN
|
||||
CALL COMMON_STATEMENT
|
||||
ELSE
|
||||
RETURN
|
||||
ENDIF
|
||||
GO TO 10
|
||||
END
|
||||
C----------------------------------------------------
|
||||
SUBROUTINE DECLARE_STATEMENT
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CALL MATCH(K_DECLARE)
|
||||
10 CALL DECLARE_ELEMENT(P_DATA)
|
||||
IF (TT.EQ.D_COMMA) THEN
|
||||
CALL GETTOK
|
||||
GO TO 10
|
||||
ENDIF
|
||||
CALL MATCH(D_SEMI)
|
||||
RETURN
|
||||
END
|
||||
C----------------------------------------------------
|
||||
SUBROUTINE COMMON_STATEMENT
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*32 COMMON_NAME
|
||||
|
||||
CALL MATCH(K_COMMON)
|
||||
COMMON_NAME='.BLANK.'
|
||||
|
||||
IF (TT.EQ.D_SLASH) THEN
|
||||
CALL GETTOK
|
||||
IF (TT.NE.D_SLASH) THEN
|
||||
CALL MUSTBE(ID)
|
||||
COMMON_NAME=IDENTIFIER
|
||||
CALL GETTOK
|
||||
ENDIF
|
||||
CALL MATCH(D_SLASH)
|
||||
ENDIF
|
||||
|
||||
COMMON_PSECT=SETUP_COMMON_PSECT(COMMON_NAME)
|
||||
|
||||
10 CALL DECLARE_ELEMENT(COMMON_PSECT)
|
||||
IF (TT.EQ.D_COMMA) THEN
|
||||
CALL GETTOK
|
||||
GO TO 10
|
||||
ENDIF
|
||||
|
||||
CALL MATCH(D_SEMI)
|
||||
RETURN
|
||||
END
|
||||
C----------------------------------------------------
|
||||
SUBROUTINE DECLARE_ELEMENT(DEFAULT_PSECT)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
LOGICAL*4 FACTORED_LIST
|
||||
INTEGER*2 KIND,TYPE,
|
||||
# LINK,LIST_SIZE,REF,BASE,BASE_MEMBER,FLAGS
|
||||
INTEGER*2 INDEX(32),REFX(32),BASEX(32),BASE_MEMBERX(32)
|
||||
COMMON/DECLS/KIND,TYPE,NBR_ELEMENTS,ELEMENT_SIZE,
|
||||
# LINK,LIST_SIZE,REF,BASE,BASE_MEMBER,FLAGS
|
||||
LOGICAL*2 NO_MORE_DATA,STRINGLEFT
|
||||
INTEGER*4 BLOCK_SIZE,NBR_ELEMENTS,LOWER_BOUND,IFSD,ELEMENT_SIZE
|
||||
COMMON /INITDATA/ NO_MORE_DATA,STRINGLEFT,BLOCK_SIZE
|
||||
COMMON /AT_FLAG/ AT,ATM
|
||||
CHARACTER*10 STRING10
|
||||
CHARACTER*80 OPERAND,OPERAND1
|
||||
CHARACTER*32 PUBLIQUE
|
||||
CHARACTER*4 ALIGNMENT(1:8)
|
||||
DATA ALIGNMENT
|
||||
# /'BYTE','WORD','----','LONG','----','----','----','LONG'/
|
||||
C
|
||||
|
||||
FLAGS=0
|
||||
N=0
|
||||
REF=0
|
||||
THIS_PSECT=DEFAULT_PSECT
|
||||
IF (TT.EQ.D_LP) THEN
|
||||
CALL GETTOK
|
||||
FACTORED_LIST=.TRUE.
|
||||
ELSE
|
||||
FACTORED_LIST=.FALSE.
|
||||
ENDIF
|
||||
10 CONTINUE
|
||||
IF (TT.LT.101.OR.TT.GT.199) CALL MUSTBE(ID)
|
||||
IF (N.GE.32) THEN
|
||||
CALL ERROR('TOO MANY ELEMENTS IN FACTORED LIST')
|
||||
ELSE
|
||||
CALL ENTER_SYMBOL
|
||||
IF (SYMBOL_REF(SYMBOL_INDEX).EQ.S_ARG)
|
||||
# SYMBOL_FLAGS(SYMBOL_INDEX)=0
|
||||
N=N+1
|
||||
INDEX(N)=SYMBOL_INDEX
|
||||
ENDIF
|
||||
CALL GETTOK
|
||||
IF (TT.EQ.K_BASED) THEN
|
||||
CALL GETTOK
|
||||
CALL SIMPLE_VARIABLE(BTYPE)
|
||||
REFX(N)=S_BASED
|
||||
BASEX(N)=SYMBOL_INDEX
|
||||
BASE_MEMBERX(N)=MEMBER_INDEX
|
||||
IF (MEMBER_INDEX.EQ.0) THEN
|
||||
IF (BTYPE.NE.S_WORD.AND.BTYPE.NE.S_PTR.AND.
|
||||
# BTYPE.NE.S_LONG) THEN
|
||||
CALL ERROR('BASE SPECIFIER NOT LONG/ADDRESS/POINTER: '
|
||||
# //SYMBOL_PLM_ID(SYMBOL_INDEX))
|
||||
ENDIF
|
||||
ELSE
|
||||
IF (BTYPE.NE.S_WORD.AND.BTYPE.NE.S_PTR.AND.
|
||||
# BTYPE.NE.S_LONG) THEN
|
||||
CALL ERROR('BASE SPECIFIER NOT LONG/ADDRESS/POINTER: '
|
||||
# //SYMBOL_PLM_ID(SYMBOL_INDEX)//'.'//
|
||||
# MEMBER_PLM_ID(MEMBER_INDEX))
|
||||
ENDIF
|
||||
ENDIF
|
||||
ELSE
|
||||
REFX(N)=S_STATIC
|
||||
BASEX(N)=0
|
||||
BASE_MEMBERX(N)=0
|
||||
ENDIF
|
||||
IF (FACTORED_LIST) THEN
|
||||
IF (TT.EQ.D_COMMA) THEN
|
||||
CALL GETTOK
|
||||
GO TO 10
|
||||
ENDIF
|
||||
CALL MATCH(D_RP)
|
||||
ENDIF
|
||||
LINK=0
|
||||
NO_MORE_DATA=.TRUE.
|
||||
IF (TT.EQ.K_LITERALLY) THEN
|
||||
CALL GETTOK
|
||||
CALL MUSTBE(STRCON)
|
||||
CCCC STRLEN=STRLEN+1 ! Is this necessary?
|
||||
S_TOP=STRINGS_TOP(BLOCK_LEVEL)
|
||||
IF (S_TOP+STRLEN.GT.STRINGS_MAX)
|
||||
# CALL FATAL('STRING SPACE EXHAUSTED')
|
||||
STRINGS(S_TOP+1:S_TOP+STRLEN)=STRING
|
||||
STRINGS_TOP(BLOCK_LEVEL)=S_TOP+STRLEN
|
||||
KIND=S_MACRO
|
||||
TYPE=0
|
||||
NBR_ELEMENTS=0
|
||||
ELEMENT_SIZE=STRLEN
|
||||
LINK=S_TOP+1
|
||||
LIST_SIZE=0
|
||||
DO J=1,N
|
||||
IF (BASEX(J).NE.0) THEN
|
||||
CALL ERROR('LITERAL CANNOT BE BASED: '//
|
||||
# SYMBOL_PLM_ID(INDEX(J)))
|
||||
ENDIF
|
||||
REFX(J)=0
|
||||
BASEX(J)=0
|
||||
BASE_MEMBERX(J)=0
|
||||
ENDDO
|
||||
CC--- CALL GETTOK -- DONE LATER, CAUSE NEXT TOKEN MIGHT BE THIS
|
||||
CC MACR0!!
|
||||
ELSEIF (TT.EQ.K_LABEL) THEN
|
||||
CALL GETTOK
|
||||
REF=S_FORWARD
|
||||
IF (TT.EQ.K_PUBLIC) THEN
|
||||
FLAGS=FLAGS.OR.S_PUBLIC
|
||||
CALL GETTOK
|
||||
ELSEIF (TT.EQ.K_EXTERNAL) THEN
|
||||
REF=S_EXT
|
||||
CALL GETTOK
|
||||
ENDIF
|
||||
IF (REF.NE.S_EXT) THEN
|
||||
FLAGS=FLAGS.OR.S_UNDEF
|
||||
ENDIF
|
||||
KIND=S_LABEL
|
||||
TYPE=0
|
||||
NBR_ELEMENTS=0
|
||||
ELEMENT_SIZE=0
|
||||
LINK=0
|
||||
LIST_SIZE=0
|
||||
DO J=1,N
|
||||
IF (BASEX(J).NE.0) THEN
|
||||
CALL ERROR('LABEL CANNOT BE BASED: '//
|
||||
# SYMBOL_PLM_ID(INDEX(J)))
|
||||
ENDIF
|
||||
REFX(J)=S_STATIC
|
||||
BASEX(J)=0
|
||||
BASE_MEMBERX(J)=0
|
||||
ENDDO
|
||||
ELSE
|
||||
IF (TT.EQ.D_LP) THEN
|
||||
KIND=S_ARRAY
|
||||
CALL DIMENSION(NBR_ELEMENTS,LOWER_BOUND)
|
||||
ELSE
|
||||
NBR_ELEMENTS=1
|
||||
LOWER_BOUND=0
|
||||
KIND=S_SCALAR
|
||||
ENDIF
|
||||
CALL VARIABLE_TYPE
|
||||
CALL VARIABLE_ATTRIBUTES(FLAGS,REF,THIS_PSECT)
|
||||
CALL INITIALIZATION(REF,THIS_PSECT)
|
||||
IF (NBR_ELEMENTS.EQ.-1.AND.N.NE.1) THEN
|
||||
CALL ERROR('INVALID USE OF IMPLICIT DIMENSION')
|
||||
NBR_ELEMENTS=0
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
C---- ASSIGN ATTRIBUTES TO THE SYMBOLS.
|
||||
C
|
||||
DO 700 J=1,N
|
||||
I=INDEX(J)
|
||||
IF (REF.EQ.S_EXT) THEN
|
||||
SYMBOL_VAX_ID(I)=PUBLIQUE(SYMBOL_PLM_ID(I))
|
||||
IF (SAME_OVERLAY) FLAGS=FLAGS.OR.S_SAME_OVERLAY
|
||||
ENDIF
|
||||
SYMBOL_KIND(I)=KIND
|
||||
SYMBOL_TYPE(I)=TYPE
|
||||
SYMBOL_ELEMENT_SIZE(I)=ELEMENT_SIZE
|
||||
SYMBOL_LINK(I)=LINK
|
||||
SYMBOL_LIST_SIZE(I)=LIST_SIZE
|
||||
SYMBOL_PSECT(I)=THIS_PSECT
|
||||
IF ((REF.EQ.S_EXT.OR.(FLAGS.AND.S_PUBLIC).NE.0) .AND.
|
||||
# REFX(J).NE.S_STATIC) THEN
|
||||
CALL ERROR('EXTERNAL/PUBLIC VARIABLE MUST BE STATIC: '//
|
||||
# SYMBOL_PLM_ID(I))
|
||||
ENDIF
|
||||
IF (AT.NE.0.AND.REFX(J).EQ.S_BASED) THEN
|
||||
CALL ERROR('BASED VARIABLE CANNOT HAVE AT-ATTRIBUTE: '//
|
||||
# SYMBOL_PLM_ID(I))
|
||||
ENDIF
|
||||
IF (REF.EQ.0) THEN
|
||||
REF1=REFX(J)
|
||||
ELSE
|
||||
REF1=REF
|
||||
ENDIF
|
||||
IF (REF1.EQ.S_ARG) THEN
|
||||
IF (NBR_ELEMENTS*ELEMENT_SIZE.GT.4) THEN
|
||||
CALL WARN('DUBIOUS ARGUMENT OVERLAY: '//
|
||||
# SYMBOL_PLM_ID(I))
|
||||
ENDIF
|
||||
ELSEIF (SYMBOL_REF(I).EQ.S_ARG) THEN
|
||||
IF (KIND.NE.S_SCALAR.OR.TYPE.EQ.S_STRUC.OR.
|
||||
# BYTE_SIZE(TYPE).GT.4.OR.REF1.NE.S_STATIC.OR.
|
||||
# THIS_PSECT.NE.P_DATA) THEN
|
||||
CALL ERROR('ILLEGAL DECLARATION FOR FORMAL PARAMETER: '//
|
||||
# SYMBOL_PLM_ID(I))
|
||||
ENDIF
|
||||
REF1=S_ARG
|
||||
SYMBOL_LINK(I)=PROC_LEVEL
|
||||
ELSE
|
||||
IF ((PROC_FLAGS(PROC_LEVEL).AND.
|
||||
# (PROC_EXT.OR.PROC_FORWARD)).NE.0) THEN
|
||||
CALL ERROR('LOCAL DECLARATION NOT ALLOWED IN EXTERNAL'//
|
||||
# '/FORWARD PROCEDURE: '//SYMBOL_PLM_ID(I))
|
||||
ENDIF
|
||||
IF ((PROC_FLAGS(PROC_LEVEL).AND.PROC_REENT).NE.0.AND.
|
||||
# REF1.EQ.S_STATIC.AND.THIS_PSECT.EQ.P_DATA) THEN
|
||||
REF1=S_DYNAMIC
|
||||
ENDIF
|
||||
ENDIF
|
||||
SYMBOL_REF(I)=REF1
|
||||
SYMBOL_BASE(I)=BASEX(J)
|
||||
SYMBOL_BASE_MEMBER(I)=BASE_MEMBERX(J)
|
||||
SYMBOL_FLAGS(I)=FLAGS
|
||||
700 CONTINUE
|
||||
C
|
||||
C---- SET PSECT AND PERFORM ALIGNMENT IF REQUIRED.
|
||||
C
|
||||
CALL PSECT(THIS_PSECT)
|
||||
IF (AT.NE.0.AND.SYMBOL_REF(ATOM_SYM(ATM)).EQ.S_STATIC) THEN
|
||||
OPERAND1=OPERAND(ATM,N1)
|
||||
CALL EMIT1('PC.SAVE = .')
|
||||
CALL EMIT1('. = '//OPERAND1(2:N1))
|
||||
ENDIF
|
||||
IF (ALIGN_FLAG .AND. AT.EQ.0 .AND.
|
||||
# BYTE_SIZE(TYPE).GT.1 .AND. TYPE.NE.S_STRUC) THEN
|
||||
DO J=1,N
|
||||
IF (SYMBOL_REF(INDEX(J)).EQ.S_STATIC.AND.
|
||||
# THIS_PSECT.EQ.P_DATA) THEN
|
||||
CALL EMIT('.ALIGN '//ALIGNMENT(BYTE_SIZE(TYPE)))
|
||||
GO TO 801
|
||||
ENDIF
|
||||
ENDDO
|
||||
801 CONTINUE
|
||||
ENDIF
|
||||
C
|
||||
C---- DEFINE SYMBOLS WITH POSSIBLE INITIAL VALUES.
|
||||
C
|
||||
OFFSET=0
|
||||
DO 910 J=1,N
|
||||
I=INDEX(J)
|
||||
REF1=SYMBOL_REF(I)
|
||||
IF (.NOT.NO_MORE_DATA.AND.REF1.NE.S_STATIC) THEN
|
||||
CALL ERROR('ATTEMPT TO INITIALIZE NON-STATIC VARIABLE: '
|
||||
# //SYMBOL_PLM_ID(I))
|
||||
ENDIF
|
||||
IF (REF1.EQ.S_STATIC) THEN
|
||||
CALL EMIT_RELDEF4(I,'.',-LOWER_BOUND*ELEMENT_SIZE)
|
||||
BLOCK_SIZE=0
|
||||
|
||||
IF (NBR_ELEMENTS.EQ.-1) THEN ! IMPLICIT DIMENSION.
|
||||
NBR_ELEMENTS=0
|
||||
IF (NO_MORE_DATA) THEN
|
||||
CALL ERROR(
|
||||
# 'IMPLICIT DIMENSION WITHOUT INITIALIZATION LIST')
|
||||
ELSEIF (TYPE.EQ.S_STRUC) THEN
|
||||
901 DO M=LINK,LINK+LIST_SIZE-1
|
||||
DO M1=1,MEMBER_NBR_ELEMENTS(M)
|
||||
CALL INITIAL_DATA(MEMBER_TYPE(M))
|
||||
ENDDO
|
||||
ENDDO
|
||||
NBR_ELEMENTS=NBR_ELEMENTS+1
|
||||
IF (.NOT.NO_MORE_DATA) GO TO 901
|
||||
ELSE
|
||||
902 CALL INITIAL_DATA(TYPE)
|
||||
NBR_ELEMENTS=NBR_ELEMENTS+1
|
||||
IF (.NOT.NO_MORE_DATA) GO TO 902
|
||||
ENDIF
|
||||
|
||||
ELSEIF (NO_MORE_DATA) THEN ! NO INITIALIZATION.
|
||||
BLOCK_SIZE=NBR_ELEMENTS*ELEMENT_SIZE
|
||||
|
||||
ELSE ! PROCESS INITIAL/DATA.
|
||||
|
||||
DO K=1,NBR_ELEMENTS
|
||||
IF (TYPE.EQ.S_STRUC) THEN
|
||||
DO M=LINK,LINK+LIST_SIZE-1
|
||||
DO M1=1,MEMBER_NBR_ELEMENTS(M)
|
||||
CALL INITIAL_DATA(MEMBER_TYPE(M))
|
||||
ENDDO
|
||||
ENDDO
|
||||
ELSE
|
||||
CALL INITIAL_DATA(TYPE)
|
||||
ENDIF
|
||||
ENDDO
|
||||
CALL FLUSH_ASCII
|
||||
ENDIF
|
||||
|
||||
IF (BLOCK_SIZE.NE.0) THEN
|
||||
OPERAND1=STRING10(BLOCK_SIZE,IFSD)
|
||||
CALL EMIT('.BLKB '//OPERAND1(IFSD:10))
|
||||
ENDIF
|
||||
|
||||
ELSEIF (REF1.EQ.S_BASED) THEN
|
||||
CALL EMIT_ABSDEF4(SYMBOL_VAX_ID(I),
|
||||
# -LOWER_BOUND*ELEMENT_SIZE)
|
||||
ELSEIF (AT.NE.0) THEN
|
||||
SYMBOL_VAX_ID(I)=SYMBOL_VAX_ID(ATOM_SYM(ATM))
|
||||
SYMBOL_FLAGS(I)=SYMBOL_FLAGS(ATOM_SYM(ATM)).OR.S_NOTPUBLIC
|
||||
SYMBOL_DISP(I)=SYMBOL_DISP(I)+SYMBOL_DISP(ATOM_SYM(ATM))+
|
||||
# ATOM_DISP(ATM)+OFFSET
|
||||
IF (ATOM_MEM(ATM).NE.0) THEN
|
||||
SYMBOL_DISP(I)=SYMBOL_DISP(I)+
|
||||
# MEMBER_OFFSET(ATOM_MEM(ATM))
|
||||
ENDIF
|
||||
IF (REF1.EQ.S_ARG) THEN
|
||||
SYMBOL_LINK(I)=SYMBOL_LINK(ATOM_SYM(ATM))
|
||||
ENDIF
|
||||
OFFSET=OFFSET+NBR_ELEMENTS*ELEMENT_SIZE
|
||||
|
||||
ELSEIF (REF1.EQ.S_DYNAMIC) THEN
|
||||
CALL EMIT_ABSDEF4(SYMBOL_VAX_ID(I),
|
||||
# PROC_DYN_OFF(PROC_LEVEL)-LOWER_BOUND*ELEMENT_SIZE)
|
||||
PROC_DYN_OFF(PROC_LEVEL)=PROC_DYN_OFF(PROC_LEVEL)+
|
||||
# NBR_ELEMENTS*ELEMENT_SIZE
|
||||
ENDIF
|
||||
SYMBOL_NBR_ELEMENTS(I)=NBR_ELEMENTS
|
||||
SYMBOL_LOWER_BOUND(I)=LOWER_BOUND
|
||||
910 CONTINUE
|
||||
CALL POST_INITIALIZATION
|
||||
IF (AT.NE.0.AND.SYMBOL_REF(ATOM_SYM(ATM)).EQ.S_STATIC) THEN
|
||||
CALL EMIT1('. = PC.SAVE')
|
||||
ENDIF
|
||||
IF (KIND.EQ.S_MACRO) CALL GETTOK ! WE PROMISED WE WOULD!
|
||||
RETURN
|
||||
END
|
||||
C----------------------------------------------------
|
||||
SUBROUTINE SIMPLE_VARIABLE(TYPE)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
C
|
||||
CALL MUSTBE(ID)
|
||||
CALL LOOKUP_SYMBOL
|
||||
IF (SYMBOL_KIND(SYMBOL_INDEX).NE.S_SCALAR.OR.
|
||||
# SYMBOL_REF(SYMBOL_INDEX).EQ.S_BASED) THEN
|
||||
CALL ERROR('NOT A SIMPLE VARIABLE: '//
|
||||
# SYMBOL_PLM_ID(SYMBOL_INDEX))
|
||||
ENDIF
|
||||
CALL GETTOK
|
||||
IF (TT.EQ.D_DOT) THEN
|
||||
CALL GETTOK
|
||||
CALL MUSTBE(ID)
|
||||
CALL LOOKUP_MEMBER
|
||||
IF (MEMBER_KIND(MEMBER_INDEX).NE.S_SCALAR) THEN
|
||||
CALL ERROR('NOT A SIMPLE VARIABLE: '//
|
||||
# SYMBOL_PLM_ID(SYMBOL_INDEX)//'.'//
|
||||
# MEMBER_PLM_ID(MEMBER_INDEX))
|
||||
ENDIF
|
||||
CALL GETTOK
|
||||
ELSE
|
||||
MEMBER_INDEX=0
|
||||
IF (SYMBOL_TYPE(SYMBOL_INDEX).EQ.S_STRUC) THEN
|
||||
CALL ERROR('NOT A FULLY QUALIFIED REFERENCE: '//
|
||||
# SYMBOL_PLM_ID(SYMBOL_INDEX))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF (MEMBER_INDEX.EQ.0) THEN
|
||||
TYPE = SYMBOL_TYPE(SYMBOL_INDEX)
|
||||
ELSE
|
||||
TYPE = MEMBER_TYPE(MEMBER_INDEX)
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
C----------------------------------------------------
|
||||
SUBROUTINE VARIABLE_ATTRIBUTES(FLAGS,REF,THIS_PSECT)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
INTEGER*4 OFF
|
||||
COMMON /AT_FLAG/ AT,ATM
|
||||
AT=0 ! ASSUME NO AT-ATTRIBUTE.
|
||||
IF (TT.EQ.K_EXTERNAL) THEN
|
||||
REF = S_EXT
|
||||
CALL GETTOK
|
||||
ELSE
|
||||
IF (TT.EQ.K_PUBLIC) THEN
|
||||
FLAGS = FLAGS.OR.S_PUBLIC
|
||||
CALL GETTOK
|
||||
ENDIF
|
||||
IF (TT.EQ.K_AT) THEN
|
||||
CALL GETTOK
|
||||
CALL MATCH(D_LP)
|
||||
FLAGS = FLAGS .OR. S_OVERLAID
|
||||
CALL BREAK
|
||||
AT=MASSAGE(EXPRESSION(0),CX_UNSIGNED)
|
||||
IF (NODE(AT).AND.OPNODE_OP(AT).EQ.OP_LOC) THEN
|
||||
ATM=OPNODE_OPND1(AT)
|
||||
IF (.NOT.ATOM(ATM).OR.ATOM_BASE(ATM).NE.NULL.OR.
|
||||
# ATOM_SUB(ATM).NE.NULL) THEN
|
||||
CALL ERROR('NOT A RESTRICTED LOCATION REFERENCE')
|
||||
AT=0
|
||||
ENDIF
|
||||
SYMBOL_FLAGS(ATOM_SYM(ATM))=SYMBOL_FLAGS(ATOM_SYM(ATM))
|
||||
# .OR. S_OVERLAID
|
||||
ATOM_FLAGS(ATM)=ATOM_FLAGS(ATM).AND..NOT.(A_P2L+A_L2P)
|
||||
# .OR. A_CTIM ! USE COMPILE-TIME ADDR.
|
||||
# .OR. A_IMMEDIATE
|
||||
IF (SYMBOL_REF(ATOM_SYM(ATM)).EQ.S_EXT) THEN
|
||||
IF ((FLAGS.AND.S_PUBLIC).NE.0) THEN
|
||||
CALL ERROR('PUBLIC ATTRIBUTE CONFLICTS WITH '//
|
||||
# 'AT-EXTERNAL')
|
||||
ENDIF
|
||||
ELSEIF (SYMBOL_REF(ATOM_SYM(ATM)).NE.S_STATIC.AND.
|
||||
# SYMBOL_REF(ATOM_SYM(ATM)).NE.S_ARG.AND.
|
||||
# SYMBOL_REF(ATOM_SYM(ATM)).NE.S_DYNAMIC) THEN
|
||||
CALL ERROR('NOT A RESTRICTED LOCATION REFERENCE')
|
||||
AT=0
|
||||
ENDIF
|
||||
ELSE
|
||||
CALL ERROR('AT MUST BE LOCATION REFERENCE')
|
||||
AT=0
|
||||
ENDIF
|
||||
CALL MATCH(D_RP)
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF (AT.NE.0) THEN
|
||||
REF=SYMBOL_REF(ATOM_SYM(ATM))
|
||||
THIS_PSECT=SYMBOL_PSECT(ATOM_SYM(ATM))
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
C----------------------------------------------------
|
||||
SUBROUTINE DIMENSION(NBR_ELEMENTS,LOWER_BOUND)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
INTEGER*4 NBR_ELEMENTS,LOWER_BOUND
|
||||
|
||||
CALL MATCH(D_LP)
|
||||
LOWER_BOUND=0
|
||||
IF (TT.EQ.D_STAR) THEN
|
||||
NBR_ELEMENTS=-1
|
||||
CALL GETTOK
|
||||
ELSE
|
||||
CALL BREAK
|
||||
N1=EXPRESSION(0)
|
||||
CALL RESOLVE_CONTEXT(N1)
|
||||
IF (NODE_CONTEXT(N1).EQ.0) CALL SET_CONTEXT(N1,CX_SIGNED)
|
||||
CALL COERCE_TYPES(N1)
|
||||
N1=FORCE_TYPE(N1,S_LONG)
|
||||
N1=FOLD_CONSTANTS(N1)
|
||||
IF (FIXLIT(N1)) THEN
|
||||
NBR_ELEMENTS=FIXED_VAL(N1)
|
||||
ELSE
|
||||
CALL ERROR('ARRAY DIMENSION NOT A CONSTANT')
|
||||
NBR_ELEMENTS=0
|
||||
ENDIF
|
||||
IF (TT.EQ.D_COLON) THEN
|
||||
CALL GETTOK
|
||||
LOWER_BOUND=NBR_ELEMENTS
|
||||
N2=EXPRESSION(0)
|
||||
CALL RESOLVE_CONTEXT(N2)
|
||||
IF (NODE_CONTEXT(N2).EQ.0) CALL SET_CONTEXT(N2,CX_SIGNED)
|
||||
CALL COERCE_TYPES(N2)
|
||||
N2=FORCE_TYPE(N2,S_LONG)
|
||||
N2=FOLD_CONSTANTS(N2)
|
||||
IF (FIXLIT(N2)) THEN
|
||||
NBR_ELEMENTS=FIXED_VAL(N2)-LOWER_BOUND+1
|
||||
ELSE
|
||||
CALL ERROR('UPPER BOUND NOT A CONSTANT')
|
||||
NBR_ELEMENTS=0
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF (NBR_ELEMENTS.LT.0) THEN
|
||||
CALL ERROR('ARRAY SIZE IS NEGATIVE')
|
||||
NBR_ELEMENTS=0
|
||||
ENDIF
|
||||
ENDIF
|
||||
CALL MATCH(D_RP)
|
||||
RETURN
|
||||
END
|
||||
C----------------------------------------------------
|
||||
SUBROUTINE VARIABLE_TYPE
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
INTEGER*4 NBR_ELEMENTS,ELEMENT_SIZE
|
||||
COMMON/DECLS/KIND,TYPE,NBR_ELEMENTS,ELEMENT_SIZE,
|
||||
# LINK,LIST_SIZE,REF,BASE,BASE_MEMBER,FLAGS
|
||||
IF (TT.EQ.K_STRUCTURE) THEN
|
||||
CALL STRUCTURE_TYPE
|
||||
ELSE
|
||||
CALL BASIC_TYPE(TYPE)
|
||||
ELEMENT_SIZE = BYTE_SIZE(TYPE)
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
C----------------------------------------------------
|
||||
SUBROUTINE BASIC_TYPE(TYPE)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
IF (TT.EQ.K_INTEGER) THEN
|
||||
TYPE = S_INTEGER
|
||||
CALL GETTOK
|
||||
ELSEIF (TT.EQ.K_REAL) THEN
|
||||
TYPE = S_REAL
|
||||
CALL GETTOK
|
||||
ELSEIF (TT.EQ.K_POINTER) THEN
|
||||
TYPE = S_PTR
|
||||
CALL GETTOK
|
||||
ELSEIF (TT.EQ.K_WORD.OR.TT.EQ.K_ADDRESS) THEN
|
||||
TYPE = S_WORD
|
||||
CALL GETTOK
|
||||
ELSEIF (TT.EQ.K_BYTE) THEN
|
||||
TYPE = S_BYTE
|
||||
CALL GETTOK
|
||||
ELSEIF (TT.EQ.K_LONG) THEN
|
||||
TYPE = S_LONG
|
||||
CALL GETTOK
|
||||
ELSEIF (TT.EQ.K_DOUBLE) THEN
|
||||
TYPE = S_DOUBLE
|
||||
CALL GETTOK
|
||||
ELSEIF (TT.EQ.K_QUAD) THEN
|
||||
TYPE = S_QUAD
|
||||
CALL GETTOK
|
||||
ELSE
|
||||
CALL MUSTBE(NT_TYPE)
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
C----------------------------------------------------
|
||||
SUBROUTINE STRUCTURE_TYPE
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
INTEGER*4 NBR_ELEMENTS,ELEMENT_SIZE,OFF
|
||||
COMMON/DECLS/KIND,TYPE,NBR_ELEMENTS,ELEMENT_SIZE,
|
||||
# LINK,LIST_SIZE,REF,BASE,BASE_MEMBER,FLAGS
|
||||
CALL MATCH(K_STRUCTURE)
|
||||
TYPE = S_STRUC
|
||||
LINK = MEMBER_TOP(BLOCK_LEVEL)+1
|
||||
LIST_SIZE = 0
|
||||
OFF = 0
|
||||
CALL MATCH(D_LP)
|
||||
10 CALL MEMBER_ELEMENT(OFF,N)
|
||||
LIST_SIZE = LIST_SIZE+N
|
||||
IF (TT.EQ.D_COMMA) THEN
|
||||
CALL GETTOK
|
||||
GO TO 10
|
||||
ENDIF
|
||||
CALL MATCH(D_RP)
|
||||
ELEMENT_SIZE = OFF
|
||||
RETURN
|
||||
END
|
||||
C----------------------------------------------------
|
||||
SUBROUTINE MEMBER_ELEMENT(OFF,N)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
INTEGER*2 INDEX(32)
|
||||
INTEGER*4 MNBR,LB,OFF
|
||||
C
|
||||
N=0
|
||||
IF (TT.EQ.D_LP) THEN
|
||||
10 CALL GETTOK
|
||||
CALL MUSTBE(ID)
|
||||
IF (N.GE.32) THEN
|
||||
CALL ERROR('TOO MANY ELEMENTS IN FACTORED LIST')
|
||||
ELSE
|
||||
CALL ENTER_MEMBER
|
||||
N=N+1
|
||||
INDEX(N)=MEMBER_INDEX
|
||||
ENDIF
|
||||
CALL GETTOK
|
||||
IF (TT.EQ.D_COMMA) GO TO 10
|
||||
CALL MATCH(D_RP)
|
||||
ELSE
|
||||
CALL ENTER_MEMBER
|
||||
N=1
|
||||
INDEX(N)=MEMBER_INDEX
|
||||
CALL GETTOK
|
||||
ENDIF
|
||||
IF (TT.EQ.D_LP) THEN
|
||||
MKIND = S_ARRAY
|
||||
CALL DIMENSION(MNBR,LB)
|
||||
IF (MNBR.EQ.-1) THEN
|
||||
CALL ERROR('IMPLICIT DIMENSION NOT ALLOWED FOR MEMBER')
|
||||
MNBR = 0
|
||||
ENDIF
|
||||
ELSE
|
||||
MKIND = S_SCALAR
|
||||
MNBR = 1
|
||||
LB=0
|
||||
ENDIF
|
||||
CALL BASIC_TYPE(MTYPE)
|
||||
DO J=1,N
|
||||
I = INDEX(J)
|
||||
MEMBER_KIND(I) = MKIND
|
||||
MEMBER_TYPE(I) = MTYPE
|
||||
MEMBER_NBR_ELEMENTS(I) = MNBR
|
||||
MEMBER_LOWER_BOUND(I) = LB
|
||||
MEMBER_ELEMENT_SIZE(I) = BYTE_SIZE(MTYPE)
|
||||
MEMBER_OFFSET(I) = OFF-LB*MEMBER_ELEMENT_SIZE(I)
|
||||
CALL EMIT_ABSDEF4(MEMBER_VAX_ID(I),MEMBER_OFFSET(I))
|
||||
OFF = OFF+MEMBER_ELEMENT_SIZE(I)*MNBR
|
||||
ENDDO
|
||||
RETURN
|
||||
END
|
||||
92
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/effects.for
Normal file
92
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/effects.for
Normal file
@@ -0,0 +1,92 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C EFFECTS.FOR
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler determines the side effects
|
||||
C of storage assignments and procedure calls for use in common
|
||||
C subexpression elimination and basic block analysis.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 10NOV81 Alex Hunter 1. Written.
|
||||
C
|
||||
C***********************************************************************
|
||||
SUBROUTINE DETERMINE_EFFECTS_OF_ASSIGNMENT (LHS)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
IF (ATOM_MEM(LHS).NE.0) THEN
|
||||
MEMBER_SERIAL_NO(ATOM_MEM(LHS)) =
|
||||
# MEMBER_SERIAL_NO(ATOM_MEM(LHS)) + 1
|
||||
ELSE
|
||||
SYMBOL_SERIAL_NO(ATOM_SYM(LHS)) =
|
||||
# SYMBOL_SERIAL_NO(ATOM_SYM(LHS)) + 1
|
||||
ENDIF
|
||||
|
||||
IF (ASSUME_EEQ .AND.
|
||||
# SYMBOL_REF(ATOM_SYM(LHS)).EQ.S_EXT) THEN
|
||||
EXTERNAL_SERIAL_DELTA = EXTERNAL_SERIAL_DELTA + 1
|
||||
! Invalidate all externals.
|
||||
ENDIF
|
||||
|
||||
IF (ASSUME_BRO) THEN
|
||||
BASED_SERIAL_DELTA = BASED_SERIAL_DELTA + 1
|
||||
! Invalidate all based references.
|
||||
IF (ATOM_BASE(LHS).NE.NULL) THEN
|
||||
END_OF_BASIC_BLOCK = .TRUE.
|
||||
! All bets are off.
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
IF (.NOT.ASSUME_SWB) THEN
|
||||
SUBCRIPTED_SERIAL_DELTA = SUBSCRIPTED_SERIAL_DELTA + 1
|
||||
! Invalidate all array references.
|
||||
IF (ATOM_SUB(LHS).NE.NULL) THEN
|
||||
END_OF_BASIC_BLOCK = .TRUE.
|
||||
! All bets are off.
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
IF ((SYMBOL_FLAGS(ATOM_SYM(LHS)).AND.S_OVERLAID).NE.0) THEN
|
||||
OVERLAID_SERIAL_DELTA = OVERLAID_SERIAL_DELTA + 1
|
||||
! When equivalence chains are implemented, we will
|
||||
! be able to refine this if ASSUME_SVE is true.
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE DETERMINE_EFFECTS_OF_CALLING (PROC_IX)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
IF (ASSUME_PSE .AND.
|
||||
# (SYMBOL_FLAGS(PROC_IX).AND.S_NO_SIDE_EFFECTS).EQ.0) THEN
|
||||
SYMBOL_SERIAL_NO(PROC_IX) = SYMBOL_SERIAL_NO(PROC_IX) + 1
|
||||
END_OF_BASIC_BLOCK = .TRUE.
|
||||
! All bets are off.
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
191
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/emit.for
Normal file
191
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/emit.for
Normal file
@@ -0,0 +1,191 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C EMIT.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler contains routines for emitting
|
||||
C symbolic code and label definitions.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 29SEP81 Alex Hunter 1. Add EMIT_ABSDEF4 and EMIT_RELDEF4 entry
|
||||
C points. (V5.3)
|
||||
C 12NOV81 Alex Hunter 1. Use symbol_psect attribute. (V6.1)
|
||||
C 14NOV81 Alex Hunter 1. Change addressing modes. (V6.2)
|
||||
C 15FEB81 Alex Hunter 1. Change opcode column to permit longer
|
||||
C code lines. (V6.7)
|
||||
C
|
||||
C***********************************************************************
|
||||
SUBROUTINE EMIT(CODE)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*(*) CODE,PC
|
||||
CHARACTER*32 NAME,LOC_LAB,PUBLIQUE,S1
|
||||
CHARACTER*10 STRING10,DSTRING
|
||||
INTEGER*4 IVAL,IFSD,OFFSET,OFFSET4
|
||||
|
||||
IF (OBJECT_FLAG) WRITE(OUT,1000) CODE
|
||||
1000 FORMAT(2X,A)
|
||||
IF (CODE_FLAG.AND.PRINT_FLAG.AND.LIST_FLAG) THEN
|
||||
CALL ADVANCE_ONE_LINE
|
||||
WRITE(LST,2000) CODE
|
||||
2000 FORMAT(32X,A)
|
||||
ENDIF
|
||||
RETURN
|
||||
C----------------------------------------------------------
|
||||
ENTRY EMIT_LABEL(IX)
|
||||
IF ((SYMBOL_FLAGS(IX).AND.S_PUBLIC).NE.0) THEN
|
||||
S1=PUBLIQUE(SYMBOL_PLM_ID(IX))
|
||||
IF (OBJECT_FLAG) THEN
|
||||
IF (MODEL.NE.4) THEN
|
||||
WRITE(OUT,5002) S1(:LNB(S1))
|
||||
5002 FORMAT(X,A,'::'/2X,'MOVL #K.,R11')
|
||||
ELSE IF (.NOT.OVERLAY_FLAG) THEN
|
||||
WRITE(OUT,1002) S1(:LNB(S1))
|
||||
1002 FORMAT(X,A,'::'/2X,'MOVAB M.,R11')
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF (CODE_FLAG.AND.PRINT_FLAG.AND.LIST_FLAG) THEN
|
||||
CALL ADVANCE_ONE_LINE
|
||||
WRITE(LST,2002) S1(1:LNB(S1))
|
||||
2002 FORMAT(31X,A,'::')
|
||||
IF (MODEL.NE.4) THEN
|
||||
CALL ADVANCE_ONE_LINE
|
||||
WRITE(LST,4002)
|
||||
4002 FORMAT(32X,'MOVL #K.,R11')
|
||||
ELSE IF (.NOT.OVERLAY_FLAG) THEN
|
||||
CALL ADVANCE_ONE_LINE
|
||||
WRITE(LST,3002)
|
||||
3002 FORMAT(32X,'MOVAB M.,R11')
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF (OBJECT_FLAG)
|
||||
# WRITE(OUT,1003) SYMBOL_VAX_ID(IX)(1:LNB(SYMBOL_VAX_ID(IX)))
|
||||
1003 FORMAT(X,A,':')
|
||||
IF (CODE_FLAG.AND.PRINT_FLAG.AND.LIST_FLAG) THEN
|
||||
CALL ADVANCE_ONE_LINE
|
||||
WRITE(LST,2003) SYMBOL_VAX_ID(IX)(1:LNB(SYMBOL_VAX_ID(IX)))
|
||||
2003 FORMAT(31X,A,':')
|
||||
ENDIF
|
||||
RETURN
|
||||
C----------------------------------------------------------
|
||||
ENTRY EMIT_ABSDEF(NAME,OFF)
|
||||
IVAL=OFF
|
||||
GO TO 10
|
||||
C----------------------------
|
||||
ENTRY EMIT_ABSDEF4(NAME,OFFSET4)
|
||||
IVAL=OFFSET4
|
||||
10 CONTINUE
|
||||
DSTRING=STRING10(IVAL,IFSD)
|
||||
IF (OBJECT_FLAG) WRITE(OUT,1001) NAME(1:LNB(NAME)),DSTRING(IFSD:)
|
||||
1001 FORMAT(X,A,' = ',A)
|
||||
IF (CODE_FLAG.AND.PRINT_FLAG.AND.LIST_FLAG) THEN
|
||||
CALL ADVANCE_ONE_LINE
|
||||
WRITE(LST,2001) NAME(1:LNB(NAME)),DSTRING(IFSD:)
|
||||
2001 FORMAT(31X,A,' = ',A)
|
||||
ENDIF
|
||||
RETURN
|
||||
C----------------------------------------------------------
|
||||
ENTRY EMIT_RELDEF(IX,PC,OFFSET2)
|
||||
OFFSET=OFFSET2
|
||||
GO TO 20
|
||||
C----------------------------
|
||||
ENTRY EMIT_RELDEF4(IX,PC,OFFSET4)
|
||||
OFFSET=OFFSET4
|
||||
20 CONTINUE
|
||||
IF (OFFSET.NE.0) THEN
|
||||
IVAL=OFFSET
|
||||
DSTRING=STRING10(IVAL,IFSD)
|
||||
IF (IVAL.GT.0) THEN
|
||||
IFSD=IFSD-1
|
||||
DSTRING(IFSD:IFSD)='+'
|
||||
ENDIF
|
||||
ELSE
|
||||
DSTRING=' '
|
||||
IFSD=10
|
||||
ENDIF
|
||||
IF ((SYMBOL_FLAGS(IX).AND.S_PUBLIC).NE.0) THEN
|
||||
S1=PUBLIQUE(SYMBOL_PLM_ID(IX))
|
||||
IF (OBJECT_FLAG)
|
||||
# WRITE(OUT,1004) S1(:LNB(S1)),PC,
|
||||
# DSTRING(IFSD:)
|
||||
1004 FORMAT(X,A,' == ',2A)
|
||||
IF (CODE_FLAG.AND.PRINT_FLAG.AND.LIST_FLAG) THEN
|
||||
CALL ADVANCE_ONE_LINE
|
||||
WRITE(LST,2004) S1(:LNB(S1)),PC,
|
||||
# DSTRING(IFSD:)
|
||||
2004 FORMAT(31X,A,' == ',2A)
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF (MODEL.EQ.4.AND..NOT.OVERLAY_FLAG.AND.
|
||||
# SYMBOL_PSECT(IX).EQ.P_DATA) THEN
|
||||
IF (OBJECT_FLAG)
|
||||
# WRITE(OUT,1005) SYMBOL_VAX_ID(IX)(:LNB(SYMBOL_VAX_ID(IX))),
|
||||
# PC,DSTRING(IFSD:)
|
||||
1005 FORMAT(X,A,' = ',A,'-M.',A)
|
||||
IF (CODE_FLAG.AND.PRINT_FLAG.AND.LIST_FLAG) THEN
|
||||
CALL ADVANCE_ONE_LINE
|
||||
WRITE(LST,2005) SYMBOL_VAX_ID(IX)(:LNB(SYMBOL_VAX_ID(IX))),
|
||||
# PC,DSTRING(IFSD:)
|
||||
2005 FORMAT(31X,A,' = ',A,'-M.',A)
|
||||
ENDIF
|
||||
ELSE
|
||||
IF (OBJECT_FLAG)
|
||||
# WRITE(OUT,1007) SYMBOL_VAX_ID(IX)(:LNB(SYMBOL_VAX_ID(IX))),
|
||||
# PC,DSTRING(IFSD:)
|
||||
1007 FORMAT(X,A,' = ',2A)
|
||||
IF (CODE_FLAG.AND.PRINT_FLAG.AND.LIST_FLAG) THEN
|
||||
CALL ADVANCE_ONE_LINE
|
||||
WRITE(LST,2007) SYMBOL_VAX_ID(IX)(:LNB(SYMBOL_VAX_ID(IX))),
|
||||
# PC,DSTRING(IFSD:)
|
||||
2007 FORMAT(31X,A,' = ',2A)
|
||||
ENDIF
|
||||
ENDIF
|
||||
RETURN
|
||||
C----------------------------------------------------------
|
||||
ENTRY EMIT_LOCAL_LABEL(LL)
|
||||
IF (LL.EQ.0) RETURN
|
||||
LOC_LAB=LOCAL_LABEL(LL,N1)
|
||||
IF (OBJECT_FLAG) WRITE(OUT,1003) LOC_LAB(:N1)
|
||||
IF (CODE_FLAG.AND.PRINT_FLAG.AND.LIST_FLAG) THEN
|
||||
CALL ADVANCE_ONE_LINE
|
||||
WRITE(LST,2003) LOC_LAB(:N1)
|
||||
ENDIF
|
||||
PATH=.TRUE.
|
||||
RETURN
|
||||
C----------------------------------------------------------
|
||||
ENTRY EMIT1(CODE)
|
||||
IF (OBJECT_FLAG) WRITE(OUT,1006) CODE
|
||||
1006 FORMAT(X,A)
|
||||
IF (CODE_FLAG.AND.PRINT_FLAG.AND.LIST_FLAG) THEN
|
||||
CALL ADVANCE_ONE_LINE
|
||||
WRITE(LST,2006) CODE
|
||||
2006 FORMAT(31X,A)
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
11
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/errfind.com
Normal file
11
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/errfind.com
Normal file
@@ -0,0 +1,11 @@
|
||||
$! ERRFIND.COM
|
||||
$!
|
||||
$! Command file to search a PL/M-VAX source file and display all
|
||||
$! calls to the ERROR message subroutines.
|
||||
$! (Requires the WYLBUR text editor.)
|
||||
$!
|
||||
$! 02FEB82 Alex Hunter 1. Original version.
|
||||
$!
|
||||
$USE 'P1'.FOR
|
||||
L 'CALL ERROR' OR 'CALL FATAL' OR 'CALL WARN' OR 'CALL BUG'
|
||||
LO
|
||||
97
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/error.for
Normal file
97
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/error.for
Normal file
@@ -0,0 +1,97 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C ERROR.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler processes error messages
|
||||
C of several degrees of severity.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 15OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE ERROR(T)
|
||||
C
|
||||
C----- REPORT AN ERROR.
|
||||
C
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*(*) T
|
||||
C
|
||||
IF (PRINT_FLAG) THEN
|
||||
CALL ADVANCE_ONE_LINE
|
||||
WRITE(LST,1000) T(:LNB(T))
|
||||
ENDIF
|
||||
IF (.NOT.LISTING_TO_TERMINAL) THEN
|
||||
CALL TYPE_LAST_SOURCE_LINE
|
||||
WRITE(7,1000) T(:LNB(T))
|
||||
ENDIF
|
||||
1000 FORMAT(' ******** Error: 'A)
|
||||
IF (OBJECT_FLAG) WRITE(OUT,1003) T(:LNB(T))
|
||||
1003 FORMAT(' .ERROR ; ',A)
|
||||
ERRORS=ERRORS+1
|
||||
RETURN
|
||||
C--------------------------
|
||||
ENTRY FATAL(T)
|
||||
C--------------------------
|
||||
IF (PRINT_FLAG) THEN
|
||||
CALL ADVANCE_ONE_LINE
|
||||
WRITE(LST,1001) T(:LNB(T))
|
||||
ENDIF
|
||||
IF (.NOT.LISTING_TO_TERMINAL) THEN
|
||||
CALL TYPE_LAST_SOURCE_LINE
|
||||
WRITE(7,1001) T(:LNB(T))
|
||||
ENDIF
|
||||
1001 FORMAT(' ******** Fatal Error: ',A)
|
||||
IF (OBJECT_FLAG) WRITE(OUT,1003) T(:LNB(T))
|
||||
100 STOP '** COMPILATION ABORTED **'
|
||||
C--------------------------
|
||||
ENTRY WARN(T)
|
||||
C--------------------------
|
||||
IF (.NOT.WARN_FLAG) RETURN
|
||||
IF (PRINT_FLAG) THEN
|
||||
CALL ADVANCE_ONE_LINE
|
||||
WRITE(LST,1002) T(:LNB(T))
|
||||
ENDIF
|
||||
IF (.NOT.LISTING_TO_TERMINAL) THEN
|
||||
CALL TYPE_LAST_SOURCE_LINE
|
||||
WRITE(7,1002) T(:LNB(T))
|
||||
ENDIF
|
||||
1002 FORMAT(' ******** Warning: ',A)
|
||||
IF (OBJECT_FLAG) WRITE(OUT,1004) T(:LNB(T))
|
||||
1004 FORMAT(' .WARN ; ',A)
|
||||
WARNINGS=WARNINGS+1
|
||||
RETURN
|
||||
END
|
||||
C--------------------------
|
||||
SUBROUTINE BUG(T)
|
||||
C--------------------------
|
||||
IMPLICIT INTEGER*2 (A-Z)
|
||||
CHARACTER*(*) T
|
||||
CALL ERROR('COMPILER BUG -- '//T)
|
||||
200 RETURN
|
||||
END
|
||||
13
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/exlist.com
Normal file
13
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/exlist.com
Normal file
@@ -0,0 +1,13 @@
|
||||
$SET VERIFY
|
||||
$!
|
||||
$! EXLIST.COM
|
||||
$!
|
||||
$! Command file to produce listings for the export version
|
||||
$! of the PL/M-VAX compiler.
|
||||
$!
|
||||
$! 02FEB82 Alex Hunter 1. Deleted PLM$UDI listings.
|
||||
$!
|
||||
$PRI/HEAD *.FOR
|
||||
$PRI CONTROL
|
||||
$PRI/HEAD PLM.BLD,.CMP,.LNK
|
||||
$SET NOVERIFY
|
||||
589
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/exprs.for
Normal file
589
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/exprs.for
Normal file
@@ -0,0 +1,589 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C EXPRS.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler parses expressions and
|
||||
C generates the corresponding code trees.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 15OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 21OCT81 Alex Hunter 1. Basic block anaylsis. (V5.5)
|
||||
C 10NOV81 Alex Hunter 1. Add calls to EFFECTS module. (V6.0)
|
||||
C 12NOV81 Alex Hunter 1. Delete reference to S_COMMON. (V6.1)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*2 FUNCTION PRIMARY(DREFS)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
REFS=DREFS
|
||||
IF (TT.EQ.FIXCON) THEN
|
||||
PRIMARY=MAKE_FIXED(FIXVAL,0)
|
||||
CALL GETTOK
|
||||
ELSEIF (TT.EQ.FLOATCON) THEN
|
||||
PRIMARY=MAKE_FLOAT(FLOATVAL,S_REAL)
|
||||
CALL GETTOK
|
||||
ELSEIF (TT.EQ.STRCON) THEN
|
||||
IF (STRLEN.GT.2) THEN
|
||||
CALL ERROR('STRING CONSTANT HAS MORE THAN 2 CHARACTERS')
|
||||
ENDIF
|
||||
IF (STRLEN.EQ.1) THEN
|
||||
PRIMARY=MAKE_FIXED2(ICHAR(STRING(1:1)),S_BYTE)
|
||||
ELSE
|
||||
PRIMARY=MAKE_FIXED2(ICHAR(STRING(1:1))*256
|
||||
# +ICHAR(STRING(2:2)),S_WORD)
|
||||
ENDIF
|
||||
CALL GETTOK
|
||||
ELSEIF (TT.EQ.ID) THEN
|
||||
PRIMARY=VARIABLE_REFERENCE(1)
|
||||
ELSEIF (TT.EQ.D_DOT.OR.TT.EQ.D_AT) THEN
|
||||
PRIMARY=LOCATION_REFERENCE(1)
|
||||
ELSEIF (TT.EQ.D_LP) THEN
|
||||
CALL GETTOK
|
||||
PRIMARY=EXPRESSION(1)
|
||||
CALL MATCH(D_RP)
|
||||
ELSE
|
||||
CALL MUSTBE(NT_EXPRESSION)
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
C-------------------------------------------------
|
||||
INTEGER*2 FUNCTION VARIABLE_REFERENCE(DREFS)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
REFS=DREFS
|
||||
CALL MUSTBE(ID)
|
||||
CALL LOOKUP_SYMBOL
|
||||
GO TO (100,200,200,300,100), SYMBOL_KIND(SYMBOL_INDEX)
|
||||
100 CALL ERROR('IDENTIFIER ILLEGAL IN THIS CONTEXT: '//
|
||||
# SYMBOL_PLM_ID(SYMBOL_INDEX))
|
||||
VARIABLE_REFERENCE=DUMMY
|
||||
CALL GETTOK
|
||||
RETURN
|
||||
C
|
||||
C---- SCALAR OR ARRAY.
|
||||
C
|
||||
200 VARIABLE_REFERENCE=DATA_REFERENCE(REFS,.FALSE.)
|
||||
RETURN
|
||||
C
|
||||
C---- PROCEDURE.
|
||||
C
|
||||
300 VARIABLE_REFERENCE=FUNCTION_REFERENCE(REFS)
|
||||
RETURN
|
||||
END
|
||||
C-------------------------------------------------
|
||||
INTEGER*2 FUNCTION DATA_REFERENCE(DREFS,MODEX)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
LOGICAL*2 PARTIAL_OK
|
||||
EQUIVALENCE (PARTIAL_OK,MODE)
|
||||
COMMON /BUILTINS/ SYM_SUBS,MEM_SUBS
|
||||
REFS=DREFS
|
||||
MODE=MODEX
|
||||
CALL MATCH(ID)
|
||||
IF (SYMBOL_REF(SYMBOL_INDEX).EQ.S_BASED) THEN
|
||||
IF (SYMBOL_BASE_MEMBER(SYMBOL_INDEX).EQ.0) THEN
|
||||
BASE_TYPE=SYMBOL_TYPE(SYMBOL_BASE(SYMBOL_INDEX))
|
||||
ELSE
|
||||
BASE_TYPE=MEMBER_TYPE(SYMBOL_BASE_MEMBER(SYMBOL_INDEX))
|
||||
ENDIF
|
||||
BASE=MAKE_ATOM(SYMBOL_BASE(SYMBOL_INDEX),
|
||||
# SYMBOL_BASE_MEMBER(SYMBOL_INDEX),NULL,NULL,
|
||||
# BASE_TYPE,0,1)
|
||||
ELSE
|
||||
BASE=NULL
|
||||
ENDIF
|
||||
IF (TT.EQ.D_LP) THEN
|
||||
IF (SYMBOL_KIND(SYMBOL_INDEX).NE.S_ARRAY) THEN
|
||||
IF (MODE.EQ.2) GO TO 10
|
||||
CALL ERROR('NOT AN ARRAY: '//SYMBOL_PLM_ID(SYMBOL_INDEX))
|
||||
ENDIF
|
||||
CALL GETTOK
|
||||
CALL PUSH(BASE,1)
|
||||
CALL PUSH(REFS,1)
|
||||
CALL PUSH(MODE,1)
|
||||
CALL PUSH(SYMBOL_INDEX,1)
|
||||
SYM_SUBS=EXPRESSION(1)
|
||||
CALL POP(SYMBOL_INDEX,1)
|
||||
CALL POP(MODE,1)
|
||||
CALL POP(REFS,1)
|
||||
CALL POP(BASE,1)
|
||||
CALL MATCH(D_RP)
|
||||
ELSE
|
||||
IF (SYMBOL_KIND(SYMBOL_INDEX).EQ.S_ARRAY.AND..NOT.PARTIAL_OK)
|
||||
# THEN
|
||||
CALL ERROR('SUBSCRIPT MISSING AFTER '//
|
||||
# SYMBOL_PLM_ID(SYMBOL_INDEX))
|
||||
ENDIF
|
||||
10 SYM_SUBS=NULL
|
||||
ENDIF
|
||||
IF (TT.EQ.D_DOT) THEN
|
||||
CALL GETTOK
|
||||
CALL MUSTBE(ID)
|
||||
CALL LOOKUP_MEMBER
|
||||
CALL GETTOK
|
||||
IF (TT.EQ.D_LP) THEN
|
||||
IF (MEMBER_KIND(MEMBER_INDEX).NE.S_ARRAY) THEN
|
||||
IF (MODE.EQ.2) GO TO 20
|
||||
CALL ERROR('NOT AN ARRAY: '//MEMBER_PLM_ID(MEMBER_INDEX))
|
||||
ENDIF
|
||||
CALL GETTOK
|
||||
CALL PUSH(BASE,1)
|
||||
CALL PUSH(REFS,1)
|
||||
CALL PUSH(MODE,1)
|
||||
CALL PUSH(SYMBOL_INDEX,1)
|
||||
CALL PUSH(MEMBER_INDEX,1)
|
||||
CALL PUSH(SYM_SUBS,1)
|
||||
MEM_SUBS=EXPRESSION(1)
|
||||
CALL POP(SYM_SUBS,1)
|
||||
CALL POP(MEMBER_INDEX,1)
|
||||
CALL POP(SYMBOL_INDEX,1)
|
||||
CALL POP(MODE,1)
|
||||
CALL POP(REFS,1)
|
||||
CALL POP(BASE,1)
|
||||
CALL MATCH(D_RP)
|
||||
ELSE
|
||||
IF (MEMBER_KIND(MEMBER_INDEX).EQ.S_ARRAY.AND.
|
||||
# .NOT.PARTIAL_OK) THEN
|
||||
CALL ERROR('SUBSCRIPT MISSING AFTER '//
|
||||
# MEMBER_PLM_ID(MEMBER_INDEX))
|
||||
ENDIF
|
||||
20 MEM_SUBS=NULL
|
||||
ENDIF
|
||||
IF (MEMBER_INDEX.EQ.0) THEN
|
||||
TYPE=SYMBOL_TYPE(SYMBOL_INDEX)
|
||||
ELSE
|
||||
TYPE=MEMBER_TYPE(MEMBER_INDEX)
|
||||
ENDIF
|
||||
ELSE
|
||||
IF (SYMBOL_TYPE(SYMBOL_INDEX).EQ.S_STRUC) THEN
|
||||
IF (.NOT.PARTIAL_OK)
|
||||
# CALL ERROR('MEMBER NAME MISSING AFTER '//
|
||||
# SYMBOL_PLM_ID(SYMBOL_INDEX))
|
||||
SIZ=SYMBOL_ELEMENT_SIZE(SYMBOL_INDEX)
|
||||
IF (SIZ.EQ.4) THEN
|
||||
TYPE=S_LONG
|
||||
ELSEIF (SIZ.EQ.2) THEN
|
||||
TYPE=S_WORD
|
||||
ELSE
|
||||
TYPE=S_BYTE
|
||||
ENDIF
|
||||
ELSE
|
||||
TYPE=SYMBOL_TYPE(SYMBOL_INDEX)
|
||||
ENDIF
|
||||
MEMBER_INDEX=0
|
||||
MEM_SUBS=NULL
|
||||
ENDIF
|
||||
IF (SYM_SUBS.EQ.NULL) THEN
|
||||
SUBS1=NULL
|
||||
ELSE
|
||||
IF (SYMBOL_ELEMENT_SIZE(SYMBOL_INDEX).EQ.
|
||||
# BYTE_SIZE(TYPE)) THEN
|
||||
SUBS1=SYM_SUBS
|
||||
ELSEIF (MOD(SYMBOL_ELEMENT_SIZE(SYMBOL_INDEX),
|
||||
# BYTE_SIZE(TYPE)).EQ.0) THEN
|
||||
SUBS1=MAKE_NODE(OP_MUL,SYM_SUBS,
|
||||
# MAKE_FIXED2(SYMBOL_ELEMENT_SIZE(SYMBOL_INDEX)
|
||||
# /BYTE_SIZE(TYPE),0),
|
||||
# 0,0,1)
|
||||
ELSE
|
||||
SUBSCRIPT=MAKE_NODE(OP_MUL,SYM_SUBS,
|
||||
# MAKE_FIXED2(SYMBOL_ELEMENT_SIZE(SYMBOL_INDEX),0),
|
||||
# 0,0,0)
|
||||
BASE1=MAKE_ATOM(SYMBOL_INDEX,MEMBER_INDEX,BASE,SUBSCRIPT,
|
||||
# S_BYTE,0,REFS)
|
||||
BASE=MAKE_NODE(OP_LOC,BASE1,NULL,0,0,0)
|
||||
DATA_REFERENCE=MAKE_ATOM(0,0,BASE,
|
||||
# MEM_SUBS,TYPE,0,REFS)
|
||||
RETURN
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF (MEM_SUBS.EQ.NULL) THEN
|
||||
SUBSCRIPT=SUBS1
|
||||
ELSEIF (SUBS1.EQ.NULL) THEN
|
||||
SUBSCRIPT=MEM_SUBS
|
||||
ELSE
|
||||
SUBSCRIPT=MAKE_NODE(OP_ADD,SUBS1,MEM_SUBS,0,0,1)
|
||||
ENDIF
|
||||
DATA_REFERENCE=MAKE_ATOM(SYMBOL_INDEX,MEMBER_INDEX,BASE,
|
||||
# SUBSCRIPT,TYPE,0,REFS)
|
||||
RETURN
|
||||
END
|
||||
C-------------------------------------------------
|
||||
INTEGER*2 FUNCTION FUNCTION_REFERENCE(DREFS)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
PROC_IX=SYMBOL_INDEX
|
||||
|
||||
IF (SYMBOL_TYPE(PROC_IX).EQ.0) THEN
|
||||
CALL ERROR('UNTYPED PROCEDURE USED AS FUNCTION: '//
|
||||
# IDENTIFIER)
|
||||
ENDIF
|
||||
|
||||
CALL GETTOK
|
||||
|
||||
IF (SYMBOL_REF(PROC_IX).EQ.S_BUILTIN) THEN
|
||||
FUNCTION_REFERENCE=BUILTIN_FUNCTION(PROC_IX)
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
ARGLIST=NULL
|
||||
NARGS=0
|
||||
|
||||
IF (TT.EQ.D_LP) THEN
|
||||
10 CALL GETTOK
|
||||
CALL PUSH(PROC_IX,1)
|
||||
CALL PUSH(ARGLIST,1)
|
||||
CALL PUSH(NARGS,1)
|
||||
ARG=EXPRESSION(1)
|
||||
CALL POP(NARGS,1)
|
||||
CALL POP(ARGLIST,1)
|
||||
CALL POP(PROC_IX,1)
|
||||
NARGS=NARGS+1
|
||||
ARGLIST=MAKE_NODE(OP_ARG,ARGLIST,ARG,0,0,0)
|
||||
IF (TT.EQ.D_COMMA) GO TO 10
|
||||
CALL MATCH(D_RP)
|
||||
ENDIF
|
||||
|
||||
IF (NARGS.NE.SYMBOL_LIST_SIZE(PROC_IX)) THEN
|
||||
CALL ERROR('WRONG NUMBER OF ARGS TO '//
|
||||
# SYMBOL_PLM_ID(PROC_IX))
|
||||
ENDIF
|
||||
|
||||
PROC=MAKE_ATOM(PROC_IX,0,NULL,NULL,SYMBOL_TYPE(PROC_IX),0,0)
|
||||
FUNCTION_REFERENCE=MAKE_NODE(OP_CALL,PROC,ARGLIST,0,0,0)
|
||||
|
||||
CALL DETERMINE_EFFECTS_OF_CALLING(PROC_IX)
|
||||
|
||||
RETURN
|
||||
END
|
||||
C-------------------------------------------------
|
||||
INTEGER*2 FUNCTION LOCATION_REFERENCE(DREFS)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*80 OPERAND,OPERAND1,RESTRICTED_LOCATION_REFERENCE
|
||||
LOGICAL*2 CONSTANT_LIST
|
||||
CHARACTER*7 DATA_POP(S_BYTE:S_QUAD)
|
||||
DATA DATA_POP
|
||||
// '.BYTE','.WORD','.WORD','.LONG','.FLOAT','.LONG','.DOUBLE'
|
||||
,, '.QUAD'
|
||||
//
|
||||
REFS=DREFS
|
||||
IF (TT.EQ.D_DOT) THEN
|
||||
TYPE=S_LONG
|
||||
CALL GETTOK
|
||||
ELSE
|
||||
CALL MATCH(D_AT)
|
||||
TYPE=S_PTR
|
||||
ENDIF
|
||||
IF (TT.EQ.ID) THEN
|
||||
CALL LOOKUP_SYMBOL
|
||||
OPND1=DATA_REFERENCE(REFS,.TRUE.)
|
||||
IF (ATOM(OPND1) .AND. ATOM_SYM(OPND1).NE.0 .AND.
|
||||
# SYMBOL_KIND(ATOM_SYM(OPND1)).EQ.S_PROC) THEN
|
||||
ATOM_FLAGS(OPND1)=ATOM_FLAGS(OPND1).OR.A_VECTOR
|
||||
ENDIF
|
||||
IF (NODE_TYPE(OPND1).EQ.0) NODE_TYPE(OPND1)=S_BYTE
|
||||
! ABOVE IS FOR .<UNTYPED PROCEDURE>
|
||||
ELSE
|
||||
OLD_PSECT=PSECT(P_CONSTANTS)
|
||||
CALL GENERATE_LOCAL_LABEL(LLC)
|
||||
CALL EMIT_LOCAL_LABEL(LLC)
|
||||
IF (TT.EQ.D_LP) THEN
|
||||
CALL GETTOK
|
||||
CONSTANT_LIST=.TRUE.
|
||||
ELSE
|
||||
CONSTANT_LIST=.FALSE.
|
||||
ENDIF
|
||||
10 CONTINUE
|
||||
IF (TT.EQ.STRCON) THEN
|
||||
CALL EMIT('.ASCII `'//STRING(:STRLEN)//'`')
|
||||
CALL GETTOK
|
||||
ELSE
|
||||
CALL PUSH(CONSTANT_LIST,1)
|
||||
CALL PUSH(OLD_PSECT,1)
|
||||
CALL PUSH(LLC,1)
|
||||
CALL PUSH(TYPE,1)
|
||||
CONST=EXPRESSION(0)
|
||||
CALL POP(TYPE,1)
|
||||
CALL POP(LLC,1)
|
||||
CALL POP(OLD_PSECT,1)
|
||||
CALL POP(CONSTANT_LIST,1)
|
||||
CALL RESOLVE_CONTEXT(CONST)
|
||||
IF (NODE_CONTEXT(CONST).EQ.0)
|
||||
# CALL SET_CONTEXT(CONST,CX_UNSIGNED)
|
||||
CALL COERCE_TYPES(CONST)
|
||||
CONST=FOLD_CONSTANTS(CONST)
|
||||
IF (NODE(CONST).AND.OPNODE_OP(CONST).EQ.OP_LOC) THEN
|
||||
OPERAND1=RESTRICTED_LOCATION_REFERENCE(CONST,N1)
|
||||
CALL EMIT(DATA_POP(NODE_TYPE(CONST))//' '//OPERAND1(:N1))
|
||||
ELSEIF (.NOT.LITERAL(CONST)) THEN
|
||||
CALL ERROR('CONSTANT LIST ELEMENT NOT A CONSTANT')
|
||||
ELSE
|
||||
OPERAND1=OPERAND(CONST,N1)
|
||||
CALL EMIT(DATA_POP(NODE_TYPE(CONST))//' '//
|
||||
# OPERAND1(2:N1))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF (CONSTANT_LIST) THEN
|
||||
IF (TT.EQ.D_COMMA) THEN
|
||||
CALL GETTOK
|
||||
GO TO 10
|
||||
ENDIF
|
||||
CALL MATCH(D_RP)
|
||||
ENDIF
|
||||
XX=PSECT(OLD_PSECT)
|
||||
OPND1=MAKE_CONSTANT(LLC,S_BYTE)
|
||||
ENDIF
|
||||
LOCATION_REFERENCE=MAKE_NODE(OP_LOC,OPND1,NULL,0,0,REFS)
|
||||
IF (TYPE.EQ.S_LONG) THEN
|
||||
LOCATION_REFERENCE=MAKE_NODE(OP_LONG,LOCATION_REFERENCE,
|
||||
# NULL,0,0,REFS)
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
C-------------------------------------------------
|
||||
INTEGER*2 FUNCTION EXPRESSION(DREFS)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
LOGICAL*1 CANT_BE_ASSN
|
||||
REFS=DREFS
|
||||
CANT_BE_ASSN = TT.EQ.D_LP
|
||||
CALL PUSH(REFS,1)
|
||||
OPND1=LOGICAL_FACTOR(REFS)
|
||||
CALL POP(REFS,1)
|
||||
IF (TT.EQ.D_ASSN.AND.ATOM(OPND1).AND..NOT.CANT_BE_ASSN) THEN
|
||||
CALL GETTOK
|
||||
CALL PUSH(OPND1,1)
|
||||
CALL PUSH(REFS,1)
|
||||
RHS=LOGICAL_EXPRESSION(REFS)
|
||||
CALL POP(REFS,1)
|
||||
CALL POP(OPND1,1)
|
||||
EXPRESSION=MAKE_NODE(OP_ASSN,RHS,OPND1,0,0,0)
|
||||
CALL DETERMINE_EFFECTS_OF_ASSIGNMENT(OPND1)
|
||||
RETURN
|
||||
ENDIF
|
||||
10 IF (TT.EQ.K_OR.OR.TT.EQ.K_XOR) THEN
|
||||
IF (TT.EQ.K_OR) OP=OP_OR
|
||||
IF (TT.EQ.K_XOR) OP=OP_XOR
|
||||
CALL GETTOK
|
||||
CALL PUSH(OP,1)
|
||||
CALL PUSH(REFS,1)
|
||||
CALL PUSH(OPND1,1)
|
||||
OPND2=LOGICAL_FACTOR(REFS)
|
||||
CALL POP(OPND1,1)
|
||||
CALL POP(REFS,1)
|
||||
CALL POP(OP,1)
|
||||
OPND1=MAKE_NODE(OP,OPND1,OPND2,S_BYTE,0,REFS)
|
||||
ELSE
|
||||
EXPRESSION=OPND1
|
||||
RETURN
|
||||
ENDIF
|
||||
GO TO 10
|
||||
END
|
||||
C-------------------------------------------------
|
||||
INTEGER*2 FUNCTION LOGICAL_EXPRESSION(DREFS)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
REFS=DREFS
|
||||
CALL PUSH(REFS,1)
|
||||
OPND1=LOGICAL_FACTOR(REFS)
|
||||
CALL POP(REFS,1)
|
||||
10 IF (TT.EQ.K_OR.OR.TT.EQ.K_XOR) THEN
|
||||
IF (TT.EQ.K_OR) OP=OP_OR
|
||||
IF (TT.EQ.K_XOR) OP=OP_XOR
|
||||
CALL GETTOK
|
||||
CALL PUSH(OP,1)
|
||||
CALL PUSH(REFS,1)
|
||||
CALL PUSH(OPND1,1)
|
||||
OPND2=LOGICAL_FACTOR(REFS)
|
||||
CALL POP(OPND1,1)
|
||||
CALL POP(REFS,1)
|
||||
CALL POP(OP,1)
|
||||
OPND1=MAKE_NODE(OP,OPND1,OPND2,S_BYTE,0,REFS)
|
||||
ELSE
|
||||
LOGICAL_EXPRESSION=OPND1
|
||||
RETURN
|
||||
ENDIF
|
||||
GO TO 10
|
||||
END
|
||||
C-------------------------------------------------
|
||||
INTEGER*2 FUNCTION LOGICAL_FACTOR(DREFS)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
REFS=DREFS
|
||||
CALL PUSH(REFS,1)
|
||||
OPND1=LOGICAL_SECONDARY(REFS)
|
||||
CALL POP(REFS,1)
|
||||
10 IF (TT.EQ.K_AND) THEN
|
||||
CALL GETTOK
|
||||
CALL PUSH(REFS,1)
|
||||
CALL PUSH(OPND1,1)
|
||||
OPND2=LOGICAL_SECONDARY(REFS)
|
||||
CALL POP(OPND1,1)
|
||||
CALL POP(REFS,1)
|
||||
OPND1=MAKE_NODE(OP_AND,OPND1,OPND2,0,0,REFS)
|
||||
ELSE
|
||||
LOGICAL_FACTOR=OPND1
|
||||
RETURN
|
||||
ENDIF
|
||||
GO TO 10
|
||||
END
|
||||
C-------------------------------------------------
|
||||
INTEGER*2 FUNCTION LOGICAL_SECONDARY(DREFS)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
REFS=DREFS
|
||||
IF (TT.EQ.K_NOT) THEN
|
||||
CALL GETTOK
|
||||
CALL PUSH(REFS,1)
|
||||
OPND1=LOGICAL_PRIMARY(REFS)
|
||||
CALL POP(REFS,1)
|
||||
LOGICAL_SECONDARY=MAKE_NODE(OP_NOT,OPND1,NULL,0,0,REFS)
|
||||
ELSE
|
||||
LOGICAL_SECONDARY=LOGICAL_PRIMARY(REFS)
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
C-------------------------------------------------
|
||||
INTEGER*2 FUNCTION LOGICAL_PRIMARY(DREFS)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
REFS=DREFS
|
||||
CALL PUSH(REFS,1)
|
||||
OPND1=ARITHMETIC_EXPRESSION(REFS)
|
||||
CALL POP(REFS,1)
|
||||
IF (TT.GE.D_LT.AND.TT.LE.D_GE) THEN
|
||||
OP=TT-D_LT+OP_LT
|
||||
CALL GETTOK
|
||||
CALL PUSH(OP,1)
|
||||
CALL PUSH(REFS,1)
|
||||
CALL PUSH(OPND1,1)
|
||||
OPND2=ARITHMETIC_EXPRESSION(REFS)
|
||||
CALL POP(OPND1,1)
|
||||
CALL POP(REFS,1)
|
||||
CALL POP(OP,1)
|
||||
OPND1=MAKE_NODE(OP,OPND1,OPND2,0,0,REFS)
|
||||
ENDIF
|
||||
LOGICAL_PRIMARY=OPND1
|
||||
RETURN
|
||||
END
|
||||
C-------------------------------------------------
|
||||
INTEGER*2 FUNCTION ARITHMETIC_EXPRESSION(DREFS)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
REFS=DREFS
|
||||
CALL PUSH(REFS,1)
|
||||
OPND1=TERM(REFS)
|
||||
CALL POP(REFS,1)
|
||||
10 IF (TT.EQ.D_PLUS.OR.TT.EQ.D_MINUS.OR.TT.EQ.K_PLUS.OR.
|
||||
# TT.EQ.K_MINUS) THEN
|
||||
IF (TT.EQ.D_PLUS) THEN
|
||||
OP=OP_ADD
|
||||
ELSEIF (TT.EQ.D_MINUS) THEN
|
||||
OP=OP_SUB
|
||||
ELSEIF (TT.EQ.K_PLUS) THEN
|
||||
OP=OP_ADWC
|
||||
CALL WARN('PLUS PROBABLY WON''T WORK')
|
||||
ELSE
|
||||
OP=OP_SBWC
|
||||
CALL WARN('MINUS PROBABLY WON''T WORK')
|
||||
ENDIF
|
||||
CALL GETTOK
|
||||
CALL PUSH(OP,1)
|
||||
CALL PUSH(REFS,1)
|
||||
CALL PUSH(OPND1,1)
|
||||
OPND2=TERM(REFS)
|
||||
CALL POP(OPND1,1)
|
||||
CALL POP(REFS,1)
|
||||
CALL POP(OP,1)
|
||||
OPND1=MAKE_NODE(OP,OPND1,OPND2,0,0,REFS)
|
||||
ELSE
|
||||
ARITHMETIC_EXPRESSION=OPND1
|
||||
RETURN
|
||||
ENDIF
|
||||
GO TO 10
|
||||
END
|
||||
C-------------------------------------------------
|
||||
INTEGER*2 FUNCTION TERM(DREFS)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
REFS=DREFS
|
||||
CALL PUSH(REFS,1)
|
||||
OPND1=SECONDARY(REFS)
|
||||
CALL POP(REFS,1)
|
||||
10 IF (TT.EQ.D_STAR.OR.TT.EQ.D_SLASH.OR.TT.EQ.K_MOD) THEN
|
||||
IF (TT.EQ.D_STAR) OP=OP_MUL
|
||||
IF (TT.EQ.D_SLASH) OP=OP_DIV
|
||||
IF (TT.EQ.K_MOD) OP=OP_MOD
|
||||
CALL GETTOK
|
||||
CALL PUSH(OP,1)
|
||||
CALL PUSH(REFS,1)
|
||||
CALL PUSH(OPND1,1)
|
||||
OPND2=SECONDARY(REFS)
|
||||
CALL POP(OPND1,1)
|
||||
CALL POP(REFS,1)
|
||||
CALL POP(OP,1)
|
||||
OPND1=MAKE_NODE(OP,OPND1,OPND2,0,0,REFS)
|
||||
ELSE
|
||||
TERM=OPND1
|
||||
RETURN
|
||||
ENDIF
|
||||
GO TO 10
|
||||
END
|
||||
C-------------------------------------------------
|
||||
INTEGER*2 FUNCTION SECONDARY(DREFS)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
REFS=DREFS
|
||||
IF (TT.EQ.D_MINUS) THEN
|
||||
CALL GETTOK
|
||||
CALL PUSH(REFS,1)
|
||||
OPND1=PRIMARY(REFS)
|
||||
CALL POP(REFS,1)
|
||||
SECONDARY=MAKE_NODE(OP_NEG,OPND1,NULL,0,0,REFS)
|
||||
ELSE
|
||||
IF (TT.EQ.D_PLUS) CALL GETTOK
|
||||
SECONDARY=PRIMARY(REFS)
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
C-------------------------------------------------
|
||||
CHARACTER*80 FUNCTION RESTRICTED_LOCATION_REFERENCE(NOD,N)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*80 OPERAND
|
||||
|
||||
ATM=OPNODE_OPND1(NOD)
|
||||
|
||||
IF (.NOT.ATOM(ATM).OR.ATOM_BASE(ATM).NE.NULL.OR.
|
||||
# ATOM_SUB(ATM).NE.NULL.OR.
|
||||
# (SYMBOL_REF(ATOM_SYM(ATM)).NE.S_STATIC.AND.
|
||||
# SYMBOL_REF(ATOM_SYM(ATM)).NE.S_LOCAL.AND.
|
||||
# SYMBOL_REF(ATOM_SYM(ATM)).NE.S_FORWARD.AND.
|
||||
# SYMBOL_REF(ATOM_SYM(ATM)).NE.S_EXT)) THEN
|
||||
|
||||
CALL ERROR('NOT A RESTRICTED LOCATION REFERENCE')
|
||||
ENDIF
|
||||
|
||||
ATOM_FLAGS(ATM)=ATOM_FLAGS(ATM).OR.A_IMMEDIATE
|
||||
|
||||
RESTRICTED_LOCATION_REFERENCE=OPERAND(ATM,N)
|
||||
|
||||
RESTRICTED_LOCATION_REFERENCE=RESTRICTED_LOCATION_REFERENCE(2:N)
|
||||
N=N-1
|
||||
|
||||
RETURN
|
||||
END
|
||||
578
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/fold.for
Normal file
578
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/fold.for
Normal file
@@ -0,0 +1,578 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C FOLD.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler examines a code tree and
|
||||
C folds operator nodes having all constant operands. Some binary
|
||||
C operator nodes having one constant operand are also simplified.
|
||||
C Constant displacements within atom base and subscript subtrees
|
||||
C are extracted and incorporated into the atom's displacement
|
||||
C field.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 15OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 09NOV81 Alex Hunter 1. Implement CTE assumption. (V5.9)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C!!!!! COMPILE ME WITH /NOCHECK PLEASE!!!!!!!!!
|
||||
C
|
||||
INTEGER*2 FUNCTION FOLD_CONSTANTS(NODX)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
INTEGER*4 I,I1,I2
|
||||
REAL*8 R,R1,R2
|
||||
INTEGER*4 MASK(S_BYTE:S_QUAD)
|
||||
DATA MASK/'FF'X,'FFFF'X,'FFFFFFFF'X,'FFFFFFFF'X,
|
||||
# 'FFFFFFFF'X,'FFFFFFFF'X,'FFFFFFFF'X,'FFFFFFFF'X/
|
||||
|
||||
NOD=NODX
|
||||
|
||||
1 IF (NOD.EQ.NULL) GO TO 9000
|
||||
|
||||
IF (LITERAL(NOD)) GO TO 9000
|
||||
|
||||
IF (CONSTANT(NOD)) GO TO 9000
|
||||
|
||||
IF (REGISTER(NOD)) GO TO 9000
|
||||
|
||||
IF (ATOM(NOD)) THEN
|
||||
CALL PUSH(NOD,1)
|
||||
BASE=FOLD_CONSTANTS2(ATOM_BASE(NOD))
|
||||
CALL POP(NOD,1)
|
||||
ATOM_BASE(NOD)=BASE
|
||||
|
||||
CALL PUSH(NOD,1)
|
||||
CALL PUSH(BASE,1)
|
||||
SUB=FOLD_CONSTANTS2(ATOM_SUB(NOD))
|
||||
CALL POP(BASE,1)
|
||||
CALL POP(NOD,1)
|
||||
ATOM_SUB(NOD)=SUB
|
||||
|
||||
IF (NODE(BASE).AND.OPNODE_OP(BASE).EQ.OP_L2P) THEN
|
||||
ATOM_FLAGS(NOD)=ATOM_FLAGS(NOD).OR.A_L2P
|
||||
ATOM_BASE(NOD)=OPNODE_OPND1(BASE)
|
||||
ENDIF
|
||||
|
||||
ELEMENT_SIZE=BYTE_SIZE(NODE_TYPE(NOD))
|
||||
|
||||
NOD1=ATOM_SUB(NOD)
|
||||
IF (NODE(NOD1).AND.OPNODE_OP(NOD1).GT.100)
|
||||
# NOD1=OPNODE_OPND1(NOD1)
|
||||
|
||||
IF (NODE(NOD1).AND.OPNODE_OP(NOD1).EQ.OP_MUL.AND.
|
||||
# FIXLIT(OPNODE_OPND2(NOD1))) THEN
|
||||
FACTOR=FIXED_VAL(OPNODE_OPND2(NOD1))
|
||||
OPNODE_OPND1(NOD1)=EXTRACT_DISPLACEMENT(OPNODE_OPND1(NOD1)
|
||||
# ,DISP)
|
||||
ATOM_DISP(NOD)=ATOM_DISP(NOD)+DISP*FACTOR*ELEMENT_SIZE
|
||||
ELSE
|
||||
ATOM_SUB(NOD)=EXTRACT_DISPLACEMENT(ATOM_SUB(NOD),DISP)
|
||||
ATOM_DISP(NOD)=ATOM_DISP(NOD)+DISP*ELEMENT_SIZE
|
||||
ENDIF
|
||||
|
||||
! Check for special case of symbol(const).member(const) where
|
||||
! size(symbol_element).ne.0 modulo size(member_element).
|
||||
|
||||
IF (ATOM_SYM(NOD).EQ.0 .AND. ATOM_MEM(NOD).EQ.0 .AND.
|
||||
# ATOM_SUB(NOD).EQ.NULL .AND. NODE(ATOM_BASE(NOD)) .AND.
|
||||
# OPNODE_OP(ATOM_BASE(NOD)).EQ.OP_LOC .AND.
|
||||
# ATOM(OPNODE_OPND1(ATOM_BASE(NOD))) .AND.
|
||||
# ATOM_SUB(OPNODE_OPND1(ATOM_BASE(NOD))).EQ.NULL ) THEN
|
||||
|
||||
NOD1=OPNODE_OPND1(ATOM_BASE(NOD))
|
||||
NODE_TYPE(NOD1)=NODE_TYPE(NOD)
|
||||
ATOM_DISP(NOD1)=ATOM_DISP(NOD1)+ATOM_DISP(NOD)
|
||||
FOLD_CONSTANTS=NOD1
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
GO TO 9000
|
||||
|
||||
ENDIF
|
||||
|
||||
C-------------- NODE MUST BE AN OPNODE.
|
||||
|
||||
IF (OPNODE_OP(NOD).EQ.OP_NOP .OR.
|
||||
# (OPNODE_OP(NOD).EQ.OP_L2P .OR.
|
||||
# OPNODE_OP(NOD).EQ.OP_P2L)) THEN
|
||||
NOD=OPNODE_OPND1(NOD)
|
||||
GO TO 1
|
||||
ENDIF
|
||||
|
||||
IF (.NOT.ASSUME_CTE) RETURN
|
||||
|
||||
CALL PUSH(NOD,1)
|
||||
OPND1=FOLD_CONSTANTS2(OPNODE_OPND1(NOD))
|
||||
CALL POP(NOD,1)
|
||||
OPNODE_OPND1(NOD)=OPND1
|
||||
|
||||
CALL PUSH(NOD,1)
|
||||
CALL PUSH(OPND1,1)
|
||||
OPND2=FOLD_CONSTANTS2(OPNODE_OPND2(NOD))
|
||||
CALL POP(OPND1,1)
|
||||
CALL POP(NOD,1)
|
||||
OPNODE_OPND2(NOD)=OPND2
|
||||
|
||||
OP=OPNODE_OP(NOD)
|
||||
IF (OP.EQ.OP_CALL.OR.OP.EQ.OP_ARG.OR.OP.EQ.OP_THEN.OR.
|
||||
# OP.EQ.OP_ALSO) GO TO 9000
|
||||
|
||||
CC IF (OP.EQ.OP_P2L) THEN
|
||||
CC IF (NODE(OPND1).AND.OPNODE_OP(OPND1).EQ.OP_LOC.AND.
|
||||
CC # ATOM(OPNODE_OPND1(OPND1))) THEN
|
||||
CC ATOM_FLAGS(OPNODE_OPND1(OPND1))=
|
||||
CC # ATOM_FLAGS(OPNODE_OPND1(OPND1)).OR.A_P2L
|
||||
CC NODE_TYPE(OPND1)=S_LONG
|
||||
CC FOLD_CONSTANTS=OPND1
|
||||
CC RETURN
|
||||
CC ELSE
|
||||
CC GO TO 9000
|
||||
CC ENDIF
|
||||
CC ENDIF
|
||||
|
||||
IF (.NOT.LITERAL(OPND1).AND..NOT.LITERAL(OPND2)) GO TO 9000
|
||||
|
||||
TYPE=NODE_TYPE(NOD)
|
||||
TYPE1=NODE_TYPE(OPNODE_OPND1(NOD))
|
||||
TYPE2=NODE_TYPE(OPNODE_OPND2(NOD))
|
||||
|
||||
IF (LITERAL(OPND1)) THEN
|
||||
IF (TYPE1.EQ.S_REAL.OR.TYPE1.EQ.S_DOUBLE) THEN
|
||||
R1=FLOAT_VAL(OPND1)
|
||||
ELSE
|
||||
I1=FIXED_VAL(OPND1).AND.MASK(TYPE1)
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
IF (LITERAL(OPND2)) THEN
|
||||
IF (TYPE2.EQ.S_REAL.OR.TYPE2.EQ.S_DOUBLE) THEN
|
||||
R2=FLOAT_VAL(OPND2)
|
||||
ELSE
|
||||
I2=FIXED_VAL(OPND2).AND.MASK(TYPE1)
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
IF (LITERAL(OPND1).AND.(LITERAL(OPND2).OR.OPND2.EQ.NULL)) THEN
|
||||
IF (TYPE1.NE.S_REAL.AND.TYPE1.NE.S_DOUBLE) THEN
|
||||
GO TO (10,20,30,40,50,60,70,80,90,100,110,120,130,140,
|
||||
# 150,160,170,180,190,200), OP
|
||||
ELSE
|
||||
GO TO (15,25,35,45,55,65,75,85,95,105,115,125,135,145,
|
||||
# 155,165,175,185,195,205), OP
|
||||
ENDIF
|
||||
GO TO (1010,1020,1030,1040,1050,1060,1070,1080,1090,1100,
|
||||
# 1110,1120,1130,1140,1150,1160,1170,1180,1190,1200,
|
||||
# 1210,1220,1230,1240,1250,1260,1270), OP-100
|
||||
CALL BUG('FC-1')
|
||||
ENDIF
|
||||
|
||||
C---------- BINARY OPERATION WITH EXACTLY ONE LITERAL OPERAND.
|
||||
|
||||
IF (LITERAL(OPND1)) THEN
|
||||
LITOPND=OPND1
|
||||
OPND=OPND2
|
||||
I=I1
|
||||
R=R1
|
||||
ELSE
|
||||
LITOPND=OPND2
|
||||
OPND=OPND1
|
||||
I=I2
|
||||
R=R2
|
||||
ENDIF
|
||||
|
||||
IF (TYPE1.NE.S_REAL.AND.TYPE1.NE.S_DOUBLE) THEN
|
||||
GO TO (13,23,33,43,53,63,73,83,93,103,113), OP
|
||||
IF (OP.EQ.20) GO TO 203
|
||||
ELSE
|
||||
GO TO (18,28,38,48,58,68,78,88,98,108,118), OP
|
||||
IF (OP.EQ.20) GO TO 208
|
||||
ENDIF
|
||||
|
||||
GO TO 9000
|
||||
|
||||
C--------- SIMPLIFY BINARY OPERATIONS WITH ONE CONSTANT OPERAND.
|
||||
|
||||
13 IF (I.EQ.0) GO TO 9100 ! ADD
|
||||
IF (FIXLIT(OPND1)) THEN
|
||||
FOLD_CONSTANTS=FOLD_LOC_REF(NOD,OPND2,I)
|
||||
ELSE
|
||||
FOLD_CONSTANTS=FOLD_LOC_REF(NOD,OPND1,I)
|
||||
ENDIF
|
||||
RETURN
|
||||
18 IF (R.EQ.0.0) GO TO 9100
|
||||
GO TO 9000
|
||||
|
||||
23 IF (FIXLIT(OPND1).AND.I1.EQ.0) GO TO 9300 ! SUB
|
||||
IF (FIXLIT(OPND2).AND.I2.EQ.0) GO TO 9100
|
||||
IF (FIXLIT(OPND2)) THEN
|
||||
FOLD_CONSTANTS=FOLD_LOC_REF(NOD,OPND1,-I)
|
||||
RETURN
|
||||
ENDIF
|
||||
GO TO 9000
|
||||
28 IF (FLOATLIT(OPND1).AND.R1.EQ.0.0) GO TO 9300
|
||||
IF (FLOATLIT(OPND2).AND.R2.EQ.0.0) GO TO 9100
|
||||
GO TO 9000
|
||||
|
||||
33 IF (I.EQ.0) GO TO 9200 ! MUL
|
||||
IF (I.EQ.1) GO TO 9100
|
||||
IF (I.EQ.-1) GO TO 9300
|
||||
GO TO 9000
|
||||
38 IF (R.EQ.0.0) GO TO 9200
|
||||
IF (R.EQ.1.0) GO TO 9100
|
||||
IF (R.EQ.-1.0) GO TO 9300
|
||||
GO TO 9000
|
||||
|
||||
43 IF (FIXLIT(OPND1).AND.I.EQ.0) GO TO 9200 ! DIV
|
||||
IF (FIXLIT(OPND2)) THEN
|
||||
IF (I.EQ.0) GO TO 9900
|
||||
IF (I.EQ.1) GO TO 9100
|
||||
IF (I.EQ.-1) GO TO 9300
|
||||
ENDIF
|
||||
GO TO 9000
|
||||
48 IF (FLOATLIT(OPND1).AND.R.EQ.0.0) GO TO 9200
|
||||
IF (FLOATLIT(OPND2)) THEN
|
||||
IF (R.EQ.0.0) GO TO 9900
|
||||
IF (R.EQ.1.0) GO TO 9100
|
||||
IF (R.EQ.-1.0) GO TO 9300
|
||||
ENDIF
|
||||
GO TO 9000
|
||||
|
||||
53 GO TO 9000 ! ADWC
|
||||
58 GO TO 9000
|
||||
|
||||
63 GO TO 9000 ! SUBWC
|
||||
68 GO TO 9000
|
||||
|
||||
73 CONTINUE ! NEG
|
||||
78 CONTINUE
|
||||
|
||||
83 CONTINUE ! NOT
|
||||
88 CONTINUE
|
||||
CALL BUG ('FC-88')
|
||||
|
||||
93 IF (FIXLIT(OPND1).AND.I1.EQ.0) GO TO 9200 ! EXT
|
||||
IF (FIXLIT(OPND1).AND.I1.EQ.MASK(TYPE1)) THEN
|
||||
IF (OPNODE_OP(OPND2).EQ.OP_NOT) THEN
|
||||
FOLD_CONSTANTS=OPNODE_OPND1(OPND2)
|
||||
RETURN
|
||||
ELSE
|
||||
GO TO 9400
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF (FIXLIT(OPND2).AND.I2.EQ.0) GO TO 9100
|
||||
IF (FIXLIT(OPND2).AND.I2.EQ.MASK(TYPE1)) THEN
|
||||
I=0
|
||||
GO TO 8000
|
||||
ENDIF
|
||||
GO TO 9000
|
||||
98 GO TO 8900
|
||||
|
||||
103 IF (I.EQ.0) GO TO 9100 ! OR
|
||||
IF (I.EQ.MASK(TYPE1)) GO TO 9200
|
||||
GO TO 9000
|
||||
108 GO TO 8900
|
||||
|
||||
113 IF (I.EQ.0) GO TO 9100 ! XOR
|
||||
IF (I.EQ.MASK(TYPE1)) GO TO 9400
|
||||
GO TO 9000
|
||||
118 GO TO 8900
|
||||
|
||||
203 IF (FIXLIT(OPND1).AND.I.EQ.0) GO TO 9200 ! MOD
|
||||
IF (FIXLIT(OPND2)) THEN
|
||||
IF (I.EQ.0) GO TO 9900
|
||||
IF (I.EQ.1.OR.I.EQ.-1) THEN
|
||||
FOLD_CONSTANTS=MAKE_FIXED(0,TYPE)
|
||||
RETURN
|
||||
ENDIF
|
||||
ENDIF
|
||||
GO TO 9000
|
||||
208 GO TO 8900
|
||||
|
||||
C------------- REDUCE OPERATIONS WITH CONSTANT OPERANDS.
|
||||
|
||||
10 I=I1+I2 ! ADD
|
||||
GO TO 8000
|
||||
15 R=R1+R2
|
||||
GO TO 8005
|
||||
|
||||
20 I=I1-I2 ! SUB
|
||||
GO TO 8000
|
||||
25 R=R1-R2
|
||||
GO TO 8005
|
||||
|
||||
30 I=I1*I2 ! MUL
|
||||
GO TO 8000
|
||||
35 R=R1*R2
|
||||
GO TO 8005
|
||||
|
||||
40 IF (I2.EQ.0) GO TO 9900 ! DIV
|
||||
I=I1/I2
|
||||
GO TO 8000
|
||||
45 IF (R2.EQ.0.0) GO TO 9900
|
||||
R=R1/R2
|
||||
GO TO 8005
|
||||
|
||||
50 GO TO 9000 ! ADWC
|
||||
55 GO TO 8900
|
||||
|
||||
60 GO TO 9000 ! SBWC
|
||||
65 GO TO 8900
|
||||
|
||||
70 I=-I1 ! NEG
|
||||
GO TO 8000
|
||||
75 R=-R1
|
||||
GO TO 8005
|
||||
|
||||
80 I=.NOT.I1 ! NOT
|
||||
GO TO 8000
|
||||
85 GO TO 8900
|
||||
|
||||
90 I=I1.AND..NOT.I2 ! EXT
|
||||
GO TO 8000
|
||||
95 GO TO 8900
|
||||
|
||||
100 I=I1.OR.I2 ! OR
|
||||
GO TO 8000
|
||||
105 GO TO 8900
|
||||
|
||||
110 I=I1.XOR.I2 ! XOR
|
||||
GO TO 8000
|
||||
115 GO TO 8900
|
||||
|
||||
120 I=I1.LT.I2 ! LT
|
||||
GO TO 8000
|
||||
125 I=R1.LT.R2
|
||||
GO TO 8000
|
||||
|
||||
130 I=I1.GT.I2 ! GT
|
||||
GO TO 8000
|
||||
135 I=R1.GT.R2
|
||||
GO TO 8000
|
||||
|
||||
140 I=I1.EQ.I2 ! EQ
|
||||
GO TO 8000
|
||||
145 I=R1.EQ.R2
|
||||
GO TO 8000
|
||||
|
||||
150 I=I1.NE.I2 ! NE
|
||||
GO TO 8000
|
||||
155 I=R1.NE.R2
|
||||
GO TO 8000
|
||||
|
||||
160 I=I1.LE.I2 ! LE
|
||||
GO TO 8000
|
||||
165 I=R1.LE.R2
|
||||
GO TO 8000
|
||||
|
||||
170 I=I1.GE.I2 ! GE
|
||||
GO TO 8000
|
||||
175 R=R1.GE.R2
|
||||
GO TO 8000
|
||||
|
||||
180 CALL BUG('FC-180') ! LOC
|
||||
185 CALL BUG('FC-185')
|
||||
|
||||
190 CALL BUG('FC-190') ! ASSN
|
||||
195 CALL BUG('FC-195')
|
||||
|
||||
200 IF (I2.EQ.0) GO TO 9900 ! MOD
|
||||
I=MOD(I1,I2)
|
||||
GO TO 8000
|
||||
205 GO TO 8900
|
||||
|
||||
C----------- CONVERT TYPE OF LITERAL OPERAND.
|
||||
|
||||
1010 CONTINUE ! B2W
|
||||
1020 CONTINUE ! B2I
|
||||
1030 CONTINUE ! B2L
|
||||
1050 CONTINUE ! W2B
|
||||
1060 CONTINUE ! W2L
|
||||
1070 CONTINUE ! I2B
|
||||
1090 CONTINUE ! I2L
|
||||
1120 CONTINUE ! L2W
|
||||
1140 CONTINUE ! L2B
|
||||
1180 CONTINUE ! L2Q
|
||||
1240 CONTINUE ! Q2L
|
||||
I=I1
|
||||
GO TO 8000
|
||||
|
||||
1040 CONTINUE ! B2R
|
||||
1080 CONTINUE ! I2R
|
||||
1130 CONTINUE ! L2R
|
||||
1170 CONTINUE ! L2D
|
||||
1250 CONTINUE ! I2D
|
||||
R=I1
|
||||
GO TO 8005
|
||||
|
||||
1100 CONTINUE ! R2L
|
||||
1110 CONTINUE ! R2I
|
||||
1150 CONTINUE ! R2B
|
||||
1160 CONTINUE ! R2W
|
||||
1200 CONTINUE ! D2B
|
||||
1210 CONTINUE ! D2I
|
||||
1230 CONTINUE ! D2L
|
||||
I=R1
|
||||
GO TO 8000
|
||||
|
||||
1190 CONTINUE ! R2D
|
||||
1220 CONTINUE ! D2R
|
||||
R=R1
|
||||
GO TO 8005
|
||||
|
||||
1260 CONTINUE ! L2P
|
||||
1270 CONTINUE ! P2L
|
||||
GO TO 9000
|
||||
|
||||
C---------------------------------------------------
|
||||
|
||||
8000 FOLD_CONSTANTS=MAKE_FIXED(I.AND.MASK(TYPE),TYPE)
|
||||
RETURN
|
||||
|
||||
8005 FOLD_CONSTANTS=MAKE_FLOAT(R,TYPE)
|
||||
RETURN
|
||||
|
||||
8900 CALL ERROR('FC - ILLEGAL MIXING OF TYPES')
|
||||
9000 FOLD_CONSTANTS=NOD
|
||||
RETURN
|
||||
|
||||
9100 FOLD_CONSTANTS=OPND
|
||||
RETURN
|
||||
|
||||
9200 FOLD_CONSTANTS=LITOPND
|
||||
RETURN
|
||||
|
||||
9300 FOLD_CONSTANTS=MAKE_NODE(OP_NEG,OPND,NULL,TYPE,0,0)
|
||||
RETURN
|
||||
|
||||
9400 FOLD_CONSTANTS=MAKE_NODE(OP_NOT,OPND,NULL,TYPE,0,0)
|
||||
RETURN
|
||||
|
||||
9900 CALL WARN('FC - ATTEMPTED DIVISION BY ZERO')
|
||||
GO TO 9000
|
||||
END
|
||||
C----------------------------------------------------
|
||||
INTEGER*2 FUNCTION FOLD_CONSTANTS2(NODX)
|
||||
IMPLICIT INTEGER*2 (A-Z)
|
||||
FOLD_CONSTANTS2=FOLD_CONSTANTS(NODX)
|
||||
RETURN
|
||||
END
|
||||
C----------------------------------------------------
|
||||
INTEGER*2 FUNCTION EXTRACT_DISPLACEMENT(NOD,DISP)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
INTEGER*2 COMBOP(S_BYTE:S_QUAD,S_BYTE:S_QUAD)
|
||||
DATA COMBOP/
|
||||
# 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
# OP_B2W, 0, 0, 0, 0, 0, 0, 0,
|
||||
# OP_B2I, 0, 0, 0, 0, 0, 0, 0,
|
||||
# 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
# 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
# OP_B2L,OP_W2L,OP_I2L, 0, 0, 0, 0, 0,
|
||||
# 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
# 0, 0, 0, 0, 0, 0, 0, 0/
|
||||
|
||||
NOD1=NOD
|
||||
|
||||
IF (FIXLIT(NOD1)) THEN
|
||||
DISP=FIXED_VAL(NOD1)
|
||||
EXTRACT_DISPLACEMENT=NULL
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
IF (.NOT.NODE(NOD1)) GO TO 900
|
||||
|
||||
IF (OPNODE_OP(NOD1).GT.100) NOD1=OPNODE_OPND1(NOD1)
|
||||
|
||||
IF (OPNODE_OP(NOD1).EQ.OP_ADD) THEN
|
||||
|
||||
IF (FIXLIT(OPNODE_OPND2(NOD1))) THEN
|
||||
DISP=FIXED_VAL(OPNODE_OPND2(NOD1))
|
||||
NOD2=OPNODE_OPND1(NOD1)
|
||||
ELSEIF (FIXLIT(OPNODE_OPND1(NOD1))) THEN
|
||||
DISP=FIXED_VAL(OPNODE_OPND1(NOD1))
|
||||
NOD2=OPNODE_OPND2(NOD1)
|
||||
ELSE
|
||||
GO TO 900
|
||||
ENDIF
|
||||
|
||||
ELSEIF (OPNODE_OP(NOD1).EQ.OP_SUB) THEN
|
||||
|
||||
IF (FIXLIT(OPNODE_OPND2(NOD1))) THEN
|
||||
DISP=-FIXED_VAL(OPNODE_OPND2(NOD1))
|
||||
NOD2=OPNODE_OPND1(NOD1)
|
||||
ELSE
|
||||
GO TO 900
|
||||
ENDIF
|
||||
|
||||
ELSE
|
||||
GO TO 900
|
||||
ENDIF
|
||||
|
||||
IF (OPNODE_OP(NOD).LE.100) THEN
|
||||
EXTRACT_DISPLACEMENT=NOD2
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
IF (.NOT.NODE(NOD2) .OR. OPNODE_OP(NOD2).LE.100 .OR.
|
||||
# NODE_TYPE(OPNODE_OPND1(NOD2)).GT.NODE_TYPE(NOD2)) THEN
|
||||
C------- (Note that downward/upward coercions are not transitive!) ---
|
||||
OPNODE_OPND1(NOD)=NOD2
|
||||
EXTRACT_DISPLACEMENT=NOD
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
NOD2=OPNODE_OPND1(NOD2)
|
||||
NEWOP=COMBOP(NODE_TYPE(NOD2),NODE_TYPE(NOD))
|
||||
IF (NEWOP.EQ.0) CALL BUG('ED-0')
|
||||
EXTRACT_DISPLACEMENT=MAKE_NODE(NEWOP,NOD2,NULL,NODE_TYPE(NOD),
|
||||
# 0,0)
|
||||
RETURN
|
||||
|
||||
900 DISP=0
|
||||
EXTRACT_DISPLACEMENT=NOD
|
||||
RETURN
|
||||
END
|
||||
C----------------------------------------------------
|
||||
INTEGER*2 FUNCTION FOLD_LOC_REF(NOD,OPND,I)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
INTEGER*4 I
|
||||
|
||||
IF (NODE(OPND).AND.OPNODE_OP(OPND).EQ.OP_LOC) THEN
|
||||
|
||||
ATM=OPNODE_OPND1(OPND)
|
||||
|
||||
IF (.NOT.ATOM(ATM)) GO TO 900
|
||||
|
||||
ATOM_DISP(ATM)=ATOM_DISP(ATM)+I
|
||||
FOLD_LOC_REF=OPND
|
||||
RETURN
|
||||
|
||||
ENDIF
|
||||
|
||||
900 FOLD_LOC_REF=NOD
|
||||
RETURN
|
||||
END
|
||||
245
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/gencode.for
Normal file
245
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/gencode.for
Normal file
@@ -0,0 +1,245 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C GENCODE.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler generates actual symbolic
|
||||
C MACRO assembly code from the abstract operators and operands of
|
||||
C of a code tree node.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 15OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 23OCT81 Alex Hunter 1. Add peephole optimizations for trivial
|
||||
C conversions and commutative binary
|
||||
C operators. (V5.6)
|
||||
C 09NOV81 Alex Hunter 1. Implement MCO assumption. (V5.9)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C!!!!!!!! COMPILE ME WITH /CONT=99 PLEASE!!!!!!!!!!
|
||||
C
|
||||
SUBROUTINE EMIT_CODE(OP,OPND1X,OPND2X,OPND3)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*80 OPERAND,OPERAND1,OPERAND2,OPERAND3,TEMPOPND
|
||||
CHARACTER*6 MNEM(S_BYTE:S_QUAD,2:3,1:22)
|
||||
|
||||
C BYTE WORD INTEGER POINTER REAL LONG DOUBLE QUAD
|
||||
|
||||
DATA MNEM/
|
||||
#'ADDB2','ADDW2','ADDW2','ADDL2','ADDF2','ADDL2','ADDD2','---- ',
|
||||
#'ADDB3','ADDW3','ADDW3','ADDL3','ADDF3','ADDL3','ADDD3','---- ',
|
||||
#'SUBB2','SUBW2','SUBW2','SUBL2','SUBF2','SUBL2','SUBD2','---- ',
|
||||
#'SUBB3','SUBW3','SUBW3','SUBL3','SUBF3','SUBL3','SUBD3','---- ',
|
||||
#'MULB2','MULW2','MULW2','MULL2','MULF2','MULL2','MULD2','---- ',
|
||||
#'MULB3','MULW3','MULW3','MULL3','MULF3','MULL3','MULD3','---- ',
|
||||
#'DIVB2','DIVW2','DIVW2','DIVL2','DIVF2','DIVL2','DIVD2','---- ',
|
||||
#'DIVB3','DIVW3','DIVW3','DIVL3','DIVF3','DIVL3','DIVD3','---- ',
|
||||
#'---- ','---- ','---- ','ADWC ','---- ','ADWC ','---- ','---- ',
|
||||
#'---- ','---- ','---- ','---- ','---- ','---- ','---- ','---- ',
|
||||
#'---- ','---- ','---- ','SBWC ','---- ','SBWC ','---- ','---- ',
|
||||
#'---- ','---- ','---- ','---- ','---- ','----', '---- ','---- ',
|
||||
#'MNEGB','MNEGW','MNEGW','MNEGL','MNEGF','MNEGL','MNEGD','---- ',
|
||||
#'---- ','---- ','---- ','---- ','---- ','---- ','---- ','---- ',
|
||||
#'MCOMB','MCOMW','MCOMW','MCOML','---- ','MCOML','---- ','---- ',
|
||||
#'---- ','---- ','---- ','---- ','---- ','---- ','---- ','---- ',
|
||||
#'BICB2','BICW2','BICW2','BICL2','---- ','BICL2','---- ','---- ',
|
||||
#'BICB3','BICW3','BICW3','BICL3','---- ','BICL3','---- ','---- ',
|
||||
#'BISB2','BISW2','BISW2','BISL2','---- ','BISL2','---- ','---- ',
|
||||
#'BISB3','BISW3','BISW3','BISL3','---- ','BISL3','---- ','---- ',
|
||||
#'XORB2','XORW2','XORW2','XORL2','---- ','XORL2','---- ','---- ',
|
||||
#'XORB3','XORW3','XORW3','XORL3','---- ','XORL3','---- ','---- ',
|
||||
#'CMPB ','CMPW ','CMPW ','CMPL ','CMPF ','CMPL ','CMPD ','---- ',
|
||||
#'BLSSU','BLSSU','BLSS ','BLSSU','BLSS ','BLSS ','BLSS ','---- ',
|
||||
#'CMPB ','CMPW ','CMPW ','CMPL ','CMPF ','CMPL ','CMPD ','---- ',
|
||||
#'BGTRU','BGTRU','BGTR ','BGTRU','BGTR ','BGTR ','BGTR ','---- ',
|
||||
#'CMPB ','CMPW ','CMPW ','CMPL ','CMPF ','CMPL ','CMPD ','---- ',
|
||||
#'BEQLU','BEQLU','BEQL ','BEQLU','BEQL ','BEQL ','BEQL ','---- ',
|
||||
#'CMPB ','CMPW ','CMPW ','CMPL ','CMPF ','CMPL ','CMPD ','---- ',
|
||||
#'BNEQU','BNEQU','BNEQ ','BNEQU','BNEQ ','BNEQ ','BNEQ ','---- ',
|
||||
#'CMPB ','CMPW ','CMPW ','CMPL ','CMPF ','CMPL ','CMPD ','---- ',
|
||||
#'BLEQU','BLEQU','BLEQ ','BLEQU','BLEQ ','BLEQ ','BLEQ ','---- ',
|
||||
#'CMPB ','CMPW ','CMPW ','CMPL ','CMPF ','CMPL ','CMPD ','---- ',
|
||||
#'BGEQU','BGEQU','BGEQ ','BGEQU','BGEQ ','BGEQ ','BGEQ ','---- ',
|
||||
#'MOVAB','MOVAW','MOVAW','MOVAL','MOVAF','MOVAL','MOVAD','MOVAQ',
|
||||
#'---- ','---- ','---- ','---- ','---- ','---- ','---- ','---- ',
|
||||
#'MOVB ','MOVW ','MOVW ','MOVL ','MOVF ','MOVL ','MOVD ','MOVQ ',
|
||||
#'---- ','---- ','---- ','---- ','---- ','---- ','---- ','---- ',
|
||||
#'---- ','---- ','---- ','---- ','---- ','---- ','---- ','---- ',
|
||||
#'---- ','---- ','---- ','---- ','---- ','EDIV ','---- ','---- ',
|
||||
#'---- ','---- ','---- ','---- ','---- ','---- ','---- ','---- ',
|
||||
#'---- ','---- ','---- ','---- ','---- ','---- ','---- ','---- ',
|
||||
#'BITB ','BITW ','BITW ','BITL ','---- ','BITL ','---- ','---- ',
|
||||
#'---- ','---- ','---- ','---- ','---- ','---- ','---- ','---- '/
|
||||
CHARACTER*6 CLROP(8),INCOP(8),DECOP(8),PUSHAOP(8),PUSHLOP(8),
|
||||
# TSTOP(8)
|
||||
DATA CLROP,INCOP,DECOP,PUSHAOP,PUSHLOP,TSTOP/
|
||||
#'CLRB ','CLRW ','CLRW ','CLRL ','CLRF ','CLRL ','CLRD ','CLRQ ',
|
||||
#'INCB ','INCW ','INCW ','INCL ','---- ','INCL ','---- ','---- ',
|
||||
#'DECB ','DECW ','DECW ','DECL ','---- ','DECL ','---- ','---- ',
|
||||
#'PUSHAB','PUSHAW','PUSHAW','PUSHAL','PUSHAF','PUSHAL','PUSHAD',
|
||||
# 'PUSHAQ',
|
||||
#'---- ','---- ','---- ','PUSHL','PUSHL','PUSHL','---- ','---- ',
|
||||
#'TSTB ','TSTW ','TSTW ','TSTL ','TSTF ','TSTL ','TSTD ','---- '/
|
||||
|
||||
CHARACTER*6 CNVT(OP_B2W:OP_I2D)
|
||||
DATA CNVT/
|
||||
# 'MOVZBW','MOVZBW','MOVZBL','CVTBF ','CVTWB ',
|
||||
# 'MOVZWL','CVTWB ','CVTWF ','CVTWL ','CVTFL ',
|
||||
# 'CVTFW ','CVTLW ','CVTLF ','CVTLB ','CVTFB ',
|
||||
# 'CVTFW ','CVTLD ','---- ','CVTFD ','CVTDB ',
|
||||
# 'CVTDW ','CVTDF ','CVTDL ','---- ','CVTWD '/
|
||||
|
||||
LOGICAL*1 NONTRIVIAL_CONVERSION(OP_B2W:OP_I2D)
|
||||
DATA NONTRIVIAL_CONVERSION/
|
||||
# .TRUE., .TRUE., .TRUE., .TRUE.,.FALSE.,
|
||||
# .TRUE.,.FALSE., .TRUE., .TRUE., .TRUE.,
|
||||
# .TRUE.,.FALSE., .TRUE.,.FALSE., .TRUE.,
|
||||
# .TRUE., .TRUE., .TRUE., .TRUE., .TRUE.,
|
||||
# .TRUE., .TRUE., .TRUE., .TRUE., .TRUE./
|
||||
|
||||
LOGICAL*1 COMMUTATIVE(OP_ADD:OP_BIT)
|
||||
DATA COMMUTATIVE/
|
||||
# .TRUE.,.FALSE., .TRUE.,.FALSE.,.FALSE.,.FALSE.,
|
||||
# .FALSE.,.FALSE.,.FALSE., .TRUE., .TRUE.,.FALSE.,
|
||||
# .FALSE., .TRUE., .TRUE.,.FALSE.,.FALSE.,.FALSE.,
|
||||
# .FALSE.,.FALSE.,.FALSE.,.FALSE./
|
||||
|
||||
IF (OPND1X.EQ.NULL) THEN
|
||||
OPND1=OPND2X
|
||||
OPERAND2=' '
|
||||
ELSEIF (OPND2X.EQ.NULL) THEN
|
||||
OPND1=OPND1X
|
||||
OPERAND2=' '
|
||||
ELSE
|
||||
OPND1=OPND1X
|
||||
OPND2=OPND2X
|
||||
OPERAND2=OPERAND(OPND2,N2)
|
||||
ENDIF
|
||||
|
||||
OPERAND1=OPERAND(OPND1,N1)
|
||||
IF (OPND3.NE.NULL) OPERAND3=OPERAND(OPND3,N3)
|
||||
|
||||
TYPE=NODE_TYPE(OPND1)
|
||||
IF (TYPE.EQ.0) CALL BUG('EC-0')
|
||||
|
||||
IF (OP.GE.101) THEN
|
||||
IF (OP.EQ.OP_L2Q) THEN
|
||||
IF (.NOT.REGISTER(OPND3)) CALL BUG('GC-L2Q')
|
||||
CALL EMIT('EMUL #1,'//OPERAND1(:N1)//',#0,'//
|
||||
# OPERAND3(:N3))
|
||||
ELSEIF (OP.EQ.OP_Q2L) THEN
|
||||
IF (.NOT.REGISTER(OPND1)) CALL BUG('GC-Q2L')
|
||||
IF (OPERAND1.NE.OPERAND3) THEN
|
||||
CALL EMIT('MOVL '//OPERAND1(:N1)//','//OPERAND3(:N3))
|
||||
ENDIF
|
||||
ELSEIF (OP.EQ.OP_L2P) THEN
|
||||
IF (OPERAND1.EQ.OPERAND3) THEN
|
||||
CALL EMIT('ADDL2 '//BASEV//','//OPERAND3(:N3))
|
||||
ELSE
|
||||
CALL EMIT('ADDL3 '//BASEV//','//OPERAND1(:N1)//','//
|
||||
# OPERAND3(:N3))
|
||||
ENDIF
|
||||
ELSEIF (OP.EQ.OP_P2L) THEN
|
||||
IF (OPERAND1.EQ.OPERAND3) THEN
|
||||
CALL EMIT('SUBL2 '//BASEV//','//OPERAND3(:N3))
|
||||
ELSE
|
||||
CALL EMIT('SUBL3 '//BASEV//','//OPERAND1(:N1)//','//
|
||||
# OPERAND3(:N3))
|
||||
ENDIF
|
||||
ELSE
|
||||
IF (.NOT.ASSUME_MCO.OR.
|
||||
# NONTRIVIAL_CONVERSION(OP).OR.OPERAND1.NE.OPERAND3.OR.
|
||||
# OPERAND1(N1:N1).EQ.']') THEN
|
||||
CALL EMIT(CNVT(OP)//' '//OPERAND1(:N1)//','
|
||||
# //OPERAND3(:N3))
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
ELSEIF (OP.GE.OP_LT.AND.OP.LE.OP_GE) THEN
|
||||
IF (ASSUME_MCO.AND.
|
||||
# (OPERAND1.EQ.'#0'.OR.OPERAND1.EQ.'#0.0')) THEN
|
||||
CALL EMIT(TSTOP(TYPE)//' '//OPERAND2(:N2))
|
||||
ELSE
|
||||
CALL EMIT(MNEM(TYPE,2,OP)//' '//OPERAND2(:N2)//','//
|
||||
# OPERAND1(:N1))
|
||||
ENDIF
|
||||
IF (OPND3.NE.NULL) THEN
|
||||
CALL GENERATE_LOCAL_LABEL(LL1)
|
||||
CALL GENERATE_LOCAL_LABEL(LL2)
|
||||
CALL EMIT(MNEM(TYPE,3,OP)//' '//
|
||||
# LOCAL_LABEL(LL1,N0))
|
||||
CALL EMIT('CLRB '//OPERAND3(:N3))
|
||||
CALL EMIT('BRB '//LOCAL_LABEL(LL2,N0))
|
||||
CALL EMIT_LOCAL_LABEL(LL1)
|
||||
CALL EMIT('MCOMB #0,'//OPERAND3(:N3))
|
||||
CALL EMIT_LOCAL_LABEL(LL2)
|
||||
ENDIF
|
||||
ELSE
|
||||
|
||||
IF (ASSUME_MCO.AND.
|
||||
# COMMUTATIVE(OP).AND.OPERAND1.EQ.OPERAND3) THEN
|
||||
TEMPOPND=OPERAND1
|
||||
OPERAND1=OPERAND2
|
||||
OPERAND2=TEMPOPND
|
||||
NT=N1
|
||||
N1=N2
|
||||
N2=NT
|
||||
ENDIF
|
||||
|
||||
IF (ASSUME_MCO.AND.
|
||||
# (OPERAND2.EQ.' '.OR.(OPERAND2.EQ.OPERAND3.AND.
|
||||
# MNEM(TYPE,2,OP).NE.'----'))) THEN
|
||||
IF (OP.EQ.OP_ASSN.AND.(OPERAND1.EQ.'#0'.OR.
|
||||
# OPERAND1.EQ.'#0.0')) THEN
|
||||
CALL EMIT(CLROP(TYPE)//' '//OPERAND3(:N3))
|
||||
ELSEIF (OP.EQ.OP_ADD.AND.OPERAND1.EQ.'#1') THEN
|
||||
CALL EMIT(INCOP(TYPE)//' '//OPERAND3(:N3))
|
||||
ELSEIF (OP.EQ.OP_SUB.AND.OPERAND1.EQ.'#1') THEN
|
||||
CALL EMIT(DECOP(TYPE)//' '//OPERAND3(:N3))
|
||||
ELSEIF (OP.EQ.OP_LOC.AND.OPERAND3.EQ.'-(SP)') THEN
|
||||
CALL EMIT(PUSHAOP(TYPE)//' '//OPERAND1(:N1))
|
||||
ELSEIF (OP.EQ.OP_ASSN.AND.BYTE_SIZE(TYPE).EQ.4.AND.
|
||||
# OPERAND3.EQ.'-(SP)') THEN
|
||||
CALL EMIT(PUSHLOP(TYPE)//' '//OPERAND1(:N1))
|
||||
ELSE
|
||||
CALL EMIT(MNEM(TYPE,2,OP)//' '//OPERAND1(:N1)//','//
|
||||
# OPERAND3(:N3))
|
||||
ENDIF
|
||||
ELSEIF (OPERAND2.EQ.' ') THEN
|
||||
CALL EMIT(MNEM(TYPE,2,OP)//' '//OPERAND1(:N1)//','//
|
||||
# OPERAND3(:N3))
|
||||
ELSEIF (OP.EQ.OP_MOD) THEN
|
||||
CALL EMIT(MNEM(TYPE,3,OP)//' '//OPERAND1(:N1)//','//
|
||||
# OPERAND2(:N2)//',R0,'//
|
||||
# OPERAND3(:N3))
|
||||
ELSE
|
||||
CALL EMIT(MNEM(TYPE,3,OP)//' '//OPERAND1(:N1)//
|
||||
# ','//OPERAND2(:N2)//','//OPERAND3(:N3))
|
||||
ENDIF
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
178
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/getc.for
Normal file
178
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/getc.for
Normal file
@@ -0,0 +1,178 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C GETC.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler contains routines which
|
||||
C are called by the lexical analysis module (GETLEX) to obtain
|
||||
C the next (maybe non-blank) source character. The source char-
|
||||
C acter may come from the source input file, an INCLUDE file, or
|
||||
C a macro body. When a new source line is read, it is (possibly)
|
||||
C listed, and tested to see if it is a control line.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 15OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 04FEB82 Alex Hunter 1. Delete reference to GET_CNTRL_FLD. (V6.6)
|
||||
C 2. Change name of LINE_SEQS common block.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE GETC
|
||||
C
|
||||
C----- GET NEXT CHARACTER FROM INPUT STREAM.
|
||||
C
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
INTEGER*2 W_LINE_NUMBER(0:99)
|
||||
COMMON /XQ_LINE_SEQS/ W_LINE_NUMBER
|
||||
CHARACTER*1 CR
|
||||
DATA CR /'0D'X/
|
||||
PARAMETER FIFO_MAX=10
|
||||
CHARACTER*133 FIFO_LINE(FIFO_MAX)
|
||||
INTEGER*2 FIFO_LEN(FIFO_MAX),FIFO_LINE_NO(FIFO_MAX),
|
||||
# FIFO_IN(FIFO_MAX)
|
||||
CHARACTER*300 CARD1
|
||||
|
||||
10 COL=COL+1
|
||||
20 CHAR = LITVAL(LITLEV)(COL:COL)
|
||||
|
||||
IF (CHAR.EQ.EOL) THEN
|
||||
IF (LITLEV.EQ.1) THEN
|
||||
30 IF (TABS.NE.0) THEN
|
||||
READ(IN,1000,END=100) L,CARD1
|
||||
J=1
|
||||
CARD=' '
|
||||
DO 31 I=1,L
|
||||
IF (CARD1(I:I).EQ.TAB) THEN
|
||||
J=J+TABS-MOD(J-1,TABS)
|
||||
ELSEIF (J.LE.300) THEN
|
||||
CARD(J:J)=CARD1(I:I)
|
||||
J=J+1
|
||||
ENDIF
|
||||
31 CONTINUE
|
||||
L=J-1
|
||||
ELSE
|
||||
READ(IN,1000,END=100) L,CARD
|
||||
ENDIF
|
||||
1000 FORMAT(Q,A)
|
||||
LINES_READ=LINES_READ+1
|
||||
IF (W_LINE_NUMBER(IN).GE.0) THEN
|
||||
LIST_LINE_NO=W_LINE_NUMBER(IN)
|
||||
ELSE
|
||||
LIST_LINE_NO = -W_LINE_NUMBER(IN)
|
||||
W_LINE_NUMBER(IN) = W_LINE_NUMBER(IN)-1
|
||||
ENDIF
|
||||
IF (CARD(LEFTMARGIN:LEFTMARGIN).EQ.'$') THEN
|
||||
IF (.NOT.NON_CONTROL_LINE_READ) THEN
|
||||
FIFO_DEPTH=FIFO_DEPTH+1
|
||||
IF (FIFO_DEPTH.GT.FIFO_MAX)
|
||||
# CALL FATAL('TOO MANY CONTROL LINES BEFORE FIRST '
|
||||
# //'NON-CONTROL LINE')
|
||||
FIFO_LINE(FIFO_DEPTH)=CARD
|
||||
FIFO_LEN(FIFO_DEPTH)=L
|
||||
FIFO_LINE_NO(FIFO_DEPTH)=LIST_LINE_NO
|
||||
FIFO_IN(FIFO_DEPTH)=IN
|
||||
ELSE
|
||||
CALL LIST_SOURCE_LINE(CARD(:L))
|
||||
ENDIF
|
||||
CARD(L+1:L+1)=CR
|
||||
CALL DQ SWITCH BUFFER(%REF(CARD(LEFTMARGIN+1:)),STATUS)
|
||||
CALL CONTROL_LINE
|
||||
GO TO 30
|
||||
ENDIF
|
||||
|
||||
IF (.NOT.NON_CONTROL_LINE_READ) THEN
|
||||
NON_CONTROL_LINE_READ=.TRUE.
|
||||
CALL OPEN_OUTPUT_FILES
|
||||
CALL INIT_SYMTAB
|
||||
LISTING_TO_TERMINAL=PRINT_FILE_STRING(0).GE.3.AND.
|
||||
# PRINT_FILE_STRING(1).EQ.'T'.AND.
|
||||
# PRINT_FILE_STRING(2).EQ.'T'.AND.
|
||||
# PRINT_FILE_STRING(3).EQ.':'
|
||||
CALL SUMMARY_HEAD
|
||||
LINE_NO_SAVE=LIST_LINE_NO
|
||||
IN_SAVE=IN
|
||||
SKIP_STATE_SAVE=SKIP_STATE
|
||||
SKIP_STATE=4
|
||||
DO 35 I=1,FIFO_DEPTH
|
||||
LIST_LINE_NO=FIFO_LINE_NO(I)
|
||||
IN=FIFO_IN(I)
|
||||
CALL LIST_SOURCE_LINE(FIFO_LINE(I)(:FIFO_LEN(I)))
|
||||
35 CONTINUE
|
||||
LIST_LINE_NO=LINE_NO_SAVE
|
||||
IN=IN_SAVE
|
||||
SKIP_STATE=SKIP_STATE_SAVE
|
||||
ENDIF
|
||||
|
||||
CALL LIST_SOURCE_LINE(CARD(:L))
|
||||
|
||||
GO TO (40,30,30,40), SKIP_STATE
|
||||
40 CONTINUE
|
||||
|
||||
CARD(L+2:L+2) = EOL
|
||||
COL = LEFTMARGIN
|
||||
ELSE
|
||||
LITLEV = LITLEV-1
|
||||
COL = LITCOL(LITLEV)
|
||||
ENDIF
|
||||
GO TO 20
|
||||
ENDIF
|
||||
RETURN
|
||||
|
||||
100 IF (IN.EQ.8) THEN
|
||||
CHAR=EOF
|
||||
ELSE
|
||||
CLOSE(UNIT=IN)
|
||||
IN=IN-1
|
||||
GO TO 30
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
C-------------------------------------------------------
|
||||
|
||||
SUBROUTINE GETNB
|
||||
C
|
||||
C------ GET NEXT NON-BLANK CHARACTER.
|
||||
C
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
INTEGER*4 I
|
||||
CHARACTER*1 CH
|
||||
|
||||
10 DO 20 I=COL+1,999
|
||||
CH=LITVAL(LITLEV)(I:I)
|
||||
IF (CH.NE.' '.AND.CH.NE.TAB) GO TO 30
|
||||
20 CONTINUE
|
||||
STOP 'GETNB BUG'
|
||||
30 IF (CH.EQ.EOL) THEN
|
||||
COL=I-1
|
||||
CALL GETC
|
||||
IF (CHAR.EQ.' '.OR.CHAR.EQ.TAB) GO TO 10
|
||||
ELSE
|
||||
CHAR=CH
|
||||
COL=I
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
288
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/getlex.for
Normal file
288
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/getlex.for
Normal file
@@ -0,0 +1,288 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C GETLEX.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This is the lexical analysis module of the PL/M-VAX compiler.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 29SEP81 Alex Hunter 1. Increase max string size. (V5.3)
|
||||
C 2. Replace null strings with ' '.
|
||||
C 28OCT81 Alex Hunter 1. Add new keywords. (V5.7)
|
||||
C
|
||||
C***********************************************************************
|
||||
C --- Compile me with /NOCHECK please ! ---
|
||||
|
||||
SUBROUTINE GETLEX
|
||||
C
|
||||
C----- GET A LEXICAL ELEMENT.
|
||||
C
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*100 NUMBER
|
||||
INTEGER*2 I,J,LAST,DIG,RADIX
|
||||
CHARACTER*1 UPPER(97:122)
|
||||
DATA UPPER /'A','B','C','D','E','F','G','H','I','J','K','L','M',
|
||||
# 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z'/
|
||||
CHARACTER*10 KEYWORD(101:154)
|
||||
DATA KEYWORD
|
||||
//'ADDRESS ','AND ','AT ','BASED ','BY '
|
||||
,,'BYTE ','CALL ','CASE ','DATA ','DECLARE '
|
||||
,,'DISABLE ','DO ','ELSE ','ENABLE ','END '
|
||||
,,'EOF ','EXTERNAL ','GO ','GOTO ','HALT '
|
||||
,,'IF ','INITIAL ','INTEGER ','INTERRUPT ','LABEL '
|
||||
,,'LITERALLY ','MINUS ','MOD ','NOT ','OR '
|
||||
,,'PLUS ','POINTER ','PROCEDURE ','PUBLIC ','REAL '
|
||||
,,'REENTRANT ','RETURN ','STRUCTURE ','THEN ','TO '
|
||||
,,'WHILE ','WORD ','XOR ','COMMON ','LONG '
|
||||
,,'DOUBLE ','OTHERWISE ','QUAD ','FORWARD ','SELECTOR '
|
||||
,,'DWORD ','SHORT ','BOOLEAN ','REGISTER '
|
||||
//
|
||||
CHARACTER*2 DD(201:218)
|
||||
DATA DD
|
||||
//'+ ','- ','* ','/ ','< ','> ','= ','<>','<=','>='
|
||||
,,':=',': ','; ','. ',', ','( ',') ','@ '
|
||||
//
|
||||
COMMON /ANALYZE/ KEYWORD,DD
|
||||
C
|
||||
100 IF (CHAR.EQ.' '.OR.CHAR.EQ.TAB) CALL GETNB
|
||||
C
|
||||
C /* COMMENT */ OR '/' DELIMITER.
|
||||
C
|
||||
IF (CHAR.EQ.'/') THEN
|
||||
NEXT_DELIMITER = CHAR
|
||||
CALL GETC
|
||||
IF (CHAR.NE.'*') GO TO 695
|
||||
110 CALL GETC
|
||||
120 IF (CHAR.EQ.EOF) CALL FATAL('EOF BEFORE END OF COMMENT')
|
||||
IF (CHAR.NE.'*') GO TO 110
|
||||
CALL GETC
|
||||
IF (CHAR.NE.'/') GO TO 120
|
||||
CALL GETC
|
||||
GO TO 100
|
||||
C
|
||||
C IDENTIFIER.
|
||||
C
|
||||
ELSEIF (CHAR.GE.'A'.AND.CHAR.LE.'Z' .OR. CHAR.EQ.'%' .OR.
|
||||
# CHAR.GE.'a'.AND.CHAR.LE.'z' .OR. CHAR.EQ.'_') THEN
|
||||
I=1
|
||||
NEXT_IDENTIFIER=' '
|
||||
200 IF (I.LE.32) THEN
|
||||
IF (CHAR.EQ.'%') THEN
|
||||
CHAR='$'
|
||||
ELSEIF (CHAR.GE.'a'.AND.CHAR.LE.'z') THEN
|
||||
CHAR=UPPER(ICHAR(CHAR))
|
||||
ENDIF
|
||||
NEXT_IDENTIFIER(I:I)=CHAR
|
||||
I=I+1
|
||||
ENDIF
|
||||
210 CALL GETC
|
||||
IF (CHAR.GE.'A' .AND. CHAR.LE.'Z' .OR. CHAR.EQ.'_' .OR.
|
||||
# CHAR.GE.'0' .AND. CHAR.LE.'9') GO TO 200
|
||||
IF (CHAR.EQ.'%' .OR. CHAR.GE.'a'.AND.CHAR.LE.'z') GO TO 200
|
||||
IF (CHAR.EQ.'$') GO TO 210
|
||||
I=HASH_BUCKET(HASH(NEXT_IDENTIFIER))
|
||||
225 IF (I.GT.0) THEN
|
||||
IF (SYMBOL_PLM_ID(I).EQ.NEXT_IDENTIFIER) THEN
|
||||
IF (SYMBOL_KIND(I).EQ.S_KEYWORD) GO TO 230
|
||||
IF (SYMBOL_KIND(I).EQ.S_MACRO) GO TO 240
|
||||
GO TO 226
|
||||
ENDIF
|
||||
I=SYMBOL_CHAIN(I)
|
||||
GO TO 225
|
||||
ENDIF
|
||||
226 NEXT_TOKENTYPE=ID
|
||||
RETURN
|
||||
C
|
||||
C KEYWORD.
|
||||
C
|
||||
230 I=SYMBOL_LINK(I) ! TOKEN_VALUE OF KEYWORD.
|
||||
NEXT_TOKENTYPE=I
|
||||
IF (I.EQ.K_THEN) THEN
|
||||
LIST_STNO=LIST_STNO+1
|
||||
ELSEIF (I.EQ.K_DO.OR.I.EQ.K_PROCEDURE) THEN
|
||||
LIST_BLOCK_LEVEL=LIST_BLOCK_LEVEL+1
|
||||
ELSEIF (I.EQ.K_END) THEN
|
||||
LIST_BLOCK_LEVEL=LIST_BLOCK_LEVEL-1
|
||||
ENDIF
|
||||
RETURN
|
||||
C
|
||||
C PARAMETERLESS MACRO.
|
||||
C
|
||||
240 IF (LITLEV.EQ.LITMAX) CALL FATAL('MACRO STACK OVERFLOW')
|
||||
LITCOL(LITLEV)=COL
|
||||
LITLEV=LITLEV+1
|
||||
COL=0
|
||||
LITVAL(LITLEV)=STRINGS(SYMBOL_LINK(I):SYMBOL_LINK(I)+
|
||||
# SYMBOL_ELEMENT_SIZE(I)-1)//EOL
|
||||
CALL GETC
|
||||
GO TO 100
|
||||
C
|
||||
C NUMERIC CONSTANT.
|
||||
C
|
||||
ELSEIF (CHAR.GE.'0' .AND. CHAR.LE.'9') THEN
|
||||
NUMBER=' '
|
||||
I=1
|
||||
300 IF (I.LE.100) NUMBER(I:I)=CHAR
|
||||
I=I+1
|
||||
310 CALL GETC
|
||||
IF (CHAR.GE.'0'.AND.CHAR.LE.'9' .OR.
|
||||
# CHAR.GE.'A'.AND.CHAR.LE.'Z') GO TO 300
|
||||
IF (CHAR.GE.'a'.AND.CHAR.LE.'z') THEN
|
||||
CHAR=UPPER(ICHAR(CHAR))
|
||||
GO TO 300
|
||||
ENDIF
|
||||
IF (CHAR.EQ.'$') GO TO 310
|
||||
IF (CHAR.EQ.'.') GO TO 350
|
||||
C
|
||||
C FIXED POINT CONSTANT.
|
||||
C
|
||||
LAST=I-1
|
||||
IF (NUMBER(LAST:LAST).EQ.'B') THEN
|
||||
RADIX=2
|
||||
LAST=LAST-1
|
||||
ELSEIF (NUMBER(LAST:LAST).EQ.'O' .OR.
|
||||
# NUMBER(LAST:LAST).EQ.'Q') THEN
|
||||
RADIX=8
|
||||
LAST=LAST-1
|
||||
ELSEIF (NUMBER(LAST:LAST).EQ.'D') THEN
|
||||
RADIX=10
|
||||
LAST=LAST-1
|
||||
ELSEIF (NUMBER(LAST:LAST).EQ.'H') THEN
|
||||
RADIX=16
|
||||
LAST=LAST-1
|
||||
ELSE
|
||||
RADIX=10
|
||||
ENDIF
|
||||
NEXT_FIXVAL=0
|
||||
DO 320 J=1,LAST
|
||||
IF (NUMBER(J:J).GE.'A') THEN
|
||||
DIG=ICHAR(NUMBER(J:J))-ICHAR('A')+10
|
||||
ELSE
|
||||
DIG=ICHAR(NUMBER(J:J))-ICHAR('0')
|
||||
ENDIF
|
||||
IF (DIG.GE.RADIX)
|
||||
# CALL ERROR('Illegal digit in numeric constant')
|
||||
NEXT_FIXVAL=NEXT_FIXVAL*RADIX+DIG
|
||||
320 CONTINUE
|
||||
NEXT_TOKENTYPE=FIXCON
|
||||
GO TO 400
|
||||
C
|
||||
C FLOATING POINT CONSTANT.
|
||||
C
|
||||
350 IF (I.LE.100) NUMBER(I:I)=CHAR
|
||||
I=I+1
|
||||
360 CALL GETC
|
||||
IF (CHAR.GE.'0'.AND.CHAR.LE.'9') GO TO 350
|
||||
IF (CHAR.EQ.'$') GO TO 360
|
||||
IF (CHAR.NE.'E'.AND.CHAR.NE.'e') GO TO 390
|
||||
IF (I.LE.100) NUMBER(I:I)=CHAR
|
||||
I=I+1
|
||||
CALL GETC
|
||||
IF (CHAR.NE.'+'.AND.CHAR.NE.'-') GO TO 380
|
||||
370 IF (I.LE.100) NUMBER(I:I)=CHAR
|
||||
I=I+1
|
||||
375 CALL GETC
|
||||
380 IF (CHAR.GE.'0'.AND.CHAR.LE.'9') GO TO 370
|
||||
IF (CHAR.EQ.'$') GO TO 375
|
||||
390 NEXT_TOKENTYPE=FLOATCON
|
||||
DECODE(I-1,9999,NUMBER,ERR=410) NEXT_FLOATVAL
|
||||
9999 FORMAT(G)
|
||||
400 IF (I.GT.101) CALL ERROR('Numeric constant too long')
|
||||
RETURN
|
||||
410 CALL ERROR('Invalid floating point constant')
|
||||
RETURN
|
||||
C
|
||||
C STRING.
|
||||
C
|
||||
ELSEIF (CHAR.EQ.'''') THEN
|
||||
NEXT_STRING=' '
|
||||
I=1
|
||||
500 CALL GETC
|
||||
IF (CHAR.EQ.EOF) THEN
|
||||
CALL ERROR('String is missing final quote')
|
||||
NEXT_TOKENTYPE=EOFTOK
|
||||
RETURN
|
||||
ELSEIF (CHAR.EQ.'''') THEN
|
||||
CALL GETC
|
||||
IF (CHAR.NE.'''') GO TO 510
|
||||
ENDIF
|
||||
IF (I.LE.STRING_SIZE_MAX) THEN
|
||||
NEXT_STRING(I:I)=CHAR
|
||||
I=I+1
|
||||
ELSE
|
||||
CALL ERROR('String constant is too long')
|
||||
GO TO 510
|
||||
ENDIF
|
||||
GO TO 500
|
||||
510 NEXT_TOKENTYPE=STRCON
|
||||
NEXT_STRLEN=I-1
|
||||
IF (NEXT_STRLEN.EQ.0) THEN
|
||||
CALL WARN('NULL STRING REPLACED BY '' ''')
|
||||
NEXT_STRLEN=1
|
||||
ENDIF
|
||||
RETURN
|
||||
C
|
||||
C END OF FILE.
|
||||
C
|
||||
ELSEIF (CHAR.EQ.EOF) THEN
|
||||
NEXT_TOKENTYPE=EOFTOK
|
||||
RETURN
|
||||
C
|
||||
C DELIMITER.
|
||||
C
|
||||
ELSE
|
||||
NEXT_DELIMITER=CHAR
|
||||
IF (CHAR.EQ.';') THEN
|
||||
LIST_STNO=LIST_STNO+1
|
||||
GO TO 690
|
||||
ENDIF
|
||||
IF (CHAR.EQ.'+'.OR.CHAR.EQ.'-'.OR.CHAR.EQ.'*'.OR.
|
||||
# CHAR.EQ.'='.OR.CHAR.EQ.'.'.OR.
|
||||
# CHAR.EQ.','.OR.CHAR.EQ.'('.OR.CHAR.EQ.')'.OR.
|
||||
# CHAR.EQ.'@') GO TO 690
|
||||
IF (CHAR.EQ.'<') THEN
|
||||
CALL GETC
|
||||
IF (CHAR.EQ.'>'.OR.CHAR.EQ.'=') GO TO 680
|
||||
GO TO 695
|
||||
ELSEIF (CHAR.EQ.'>'.OR.CHAR.EQ.':') THEN
|
||||
CALL GETC
|
||||
IF (CHAR.EQ.'=') GO TO 680
|
||||
GO TO 695
|
||||
ENDIF
|
||||
NEXT_TOKENTYPE=INVALID
|
||||
CALL GETC
|
||||
RETURN
|
||||
680 NEXT_DELIMITER(2:2)=CHAR
|
||||
690 CALL GETC
|
||||
695 DO 697 NEXT_TOKENTYPE=201,218
|
||||
IF (NEXT_DELIMITER.EQ.DD(NEXT_TOKENTYPE)) RETURN
|
||||
697 CONTINUE
|
||||
CALL BUG('DELIMITER NOT FOUND IN DD TABLE')
|
||||
ENDIF
|
||||
END
|
||||
73
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/gettok.for
Normal file
73
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/gettok.for
Normal file
@@ -0,0 +1,73 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C GETTOK.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler contains the token analysis
|
||||
C routine which is called to obtain the next token from the input
|
||||
C stream. The token analyzer looks ahead one lexical element to
|
||||
C determine if the next token is a label, and if so stores the
|
||||
C label in the current label list. This list must be emptied
|
||||
C before the next token is obtained, or an error will be diagnosed.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 15OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 14JAN82 Alex Hunter 1. Treat <keyword>: as <identifier>:. (V6.5)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE GETTOK
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
C
|
||||
DO 5 I=1,NLABELS
|
||||
CALL ERROR('MISPLACED LABEL -- '//LABELS(I))
|
||||
5 CONTINUE
|
||||
NLABELS=0
|
||||
10 TOKENTYPE=NEXT_TOKENTYPE
|
||||
DELIMITER=NEXT_DELIMITER
|
||||
IDENTIFIER=NEXT_IDENTIFIER
|
||||
STRING=NEXT_STRING
|
||||
STRLEN=NEXT_STRLEN
|
||||
FIXVAL=NEXT_FIXVAL
|
||||
FLOATVAL=NEXT_FLOATVAL
|
||||
|
||||
CALL GETLEX
|
||||
|
||||
IF (NEXT_TOKENTYPE.EQ.D_COLON .AND.
|
||||
# (TOKENTYPE.EQ.ID.OR.(TOKENTYPE.GE.101.AND.TOKENTYPE.LE.199)))
|
||||
#THEN
|
||||
IF (NLABELS.GE.MAX_LABELS) THEN
|
||||
CALL ERROR('TOO MANY LABELS -- '//IDENTIFIER)
|
||||
ELSE
|
||||
NLABELS=NLABELS+1
|
||||
LABELS(NLABELS) = IDENTIFIER
|
||||
ENDIF
|
||||
CALL GETLEX
|
||||
GO TO 10
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
50
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/hash.for
Normal file
50
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/hash.for
Normal file
@@ -0,0 +1,50 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C HASH.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler contains the symbol table
|
||||
C hash code routine, which maps a 32 character identifier into
|
||||
C an integer in the range [0..210].
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 18OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*4 FUNCTION HASH (ID)
|
||||
IMPLICIT INTEGER*4 (A-Z)
|
||||
CHARACTER*32 ID
|
||||
|
||||
HASH= ((
|
||||
# (ICHAR(ID(1:1))+ICHAR(ID(5:5))+ICHAR(ID(9:9)))*256
|
||||
# + (ICHAR(ID(2:2))+ICHAR(ID(6:6))+ICHAR(ID(10:10))))*256
|
||||
# + (ICHAR(ID(3:3))+ICHAR(ID(7:7))+ICHAR(ID(11:11))))*256
|
||||
# + (ICHAR(ID(4:4))+ICHAR(ID(8:8))+ICHAR(ID(12:12)))
|
||||
HASH=MOD(IABS(HASH),211)
|
||||
RETURN
|
||||
END
|
||||
360
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/init.for
Normal file
360
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/init.for
Normal file
@@ -0,0 +1,360 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C INIT.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler contains initialization
|
||||
C routines which are called just before the first non-control line
|
||||
C is processed (i.e., after all primary controls have been processed
|
||||
C but before the first program text is processed).
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 29SEP81 Alex Hunter 1. LENGTH,FIRST,LAST, and SIZE are now LONG
|
||||
C procedures.
|
||||
C 24OCT81 Alex Hunter 1. Change BI_NBR_ELEMENTS and BI_ELEMENT_SIZE
|
||||
C to INTEGER*4 per changes to corresponding
|
||||
C SYMBOL arrays. (V5.6)
|
||||
C 28OCT81 Alex Hunter 1. Add new keywords and delete '%' from
|
||||
C existing keywords, since keywords may
|
||||
C now be re-declared. (V5.7)
|
||||
C 10NOV81 Alex Hunter 1. Add S_NO_SIDE_EFFECTS attribute. (V6.0)
|
||||
C 12NOV81 Alex Hunter 1. Implement LAST(MEMORY), etc. (V6.1)
|
||||
C 2. Add BI_PSECT.
|
||||
C 3. Change the way psect names are fixed up.
|
||||
C 14NOV81 Alex Hunter 1. Append overlay name to P_CODE psect name.
|
||||
C (V6.2)
|
||||
C 21NOV81 Alex Hunter 1. Temporarily change LOW back to an external.
|
||||
C (V6.3)
|
||||
C 10JAN81 Alex Hunter 1. Change DOUBLE keyword to DOUBLE$PRECISION
|
||||
C to avoid conflict with DOUBLE builtin.
|
||||
C (V6.4).
|
||||
C
|
||||
C***********************************************************************
|
||||
SUBROUTINE INIT_SYMTAB
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*32 SYMBOL
|
||||
CHARACTER*1 MODL
|
||||
|
||||
DATA SYMBOL_VAX_ID(SYM_MLAST),SYMBOL_REF(SYM_MLAST)
|
||||
// 'MEMORY.LAST', S_VALUE /
|
||||
DATA SYMBOL_VAX_ID(SYM_MLEN),SYMBOL_REF(SYM_MLEN)
|
||||
// 'MEMORY.LEN', S_VALUE /
|
||||
DATA SYMBOL_VAX_ID(SYM_MSIZ),SYMBOL_REF(SYM_MSIZ)
|
||||
// 'MEMORY.SIZ', S_VALUE /
|
||||
DATA SYMBOL_VAX_ID(SYM_SLAST),SYMBOL_REF(SYM_SLAST)
|
||||
// 'STACK.LAST', S_VALUE /
|
||||
DATA SYMBOL_VAX_ID(SYM_SLEN),SYMBOL_REF(SYM_SLEN)
|
||||
// 'STACK.LEN', S_VALUE /
|
||||
DATA SYMBOL_VAX_ID(SYM_SSIZ),SYMBOL_REF(SYM_SSIZ)
|
||||
// 'STACK.SIZ', S_VALUE /
|
||||
|
||||
PARAMETER M = FIRST_AVAILABLE_SYMBOL_INDEX
|
||||
PARAMETER N=54 ! # OF BUILTINS.
|
||||
|
||||
CHARACTER*32 BI_PLM_ID(N),BI_VAX_ID(N)
|
||||
INTEGER*2 BI_KIND(N),BI_TYPE(N),
|
||||
# BI_LINK(N),
|
||||
# BI_LIST_SIZE(N),BI_REF(N),BI_BASE(N),
|
||||
# BI_BASE_MEMBER(N),BI_FLAGS(N),
|
||||
# BI_SERIAL_NO(N),BI_PSECT(N)
|
||||
INTEGER*4 BI_NBR_ELEMENTS(N),BI_ELEMENT_SIZE(N),
|
||||
# BI_LOWER_BOUND(N),BI_DISP(N)
|
||||
|
||||
EQUIVALENCE (BI_PLM_ID,SYMBOL_PLM_ID(M))
|
||||
,, (BI_VAX_ID,SYMBOL_VAX_ID(M))
|
||||
,, (BI_KIND,SYMBOL_KIND(M))
|
||||
,, (BI_TYPE,SYMBOL_TYPE(M))
|
||||
,, (BI_NBR_ELEMENTS,SYMBOL_NBR_ELEMENTS(M))
|
||||
,, (BI_ELEMENT_SIZE,SYMBOL_ELEMENT_SIZE(M))
|
||||
,, (BI_LOWER_BOUND,SYMBOL_LOWER_BOUND(M))
|
||||
,, (BI_LINK,SYMBOL_LINK(M))
|
||||
,, (BI_LIST_SIZE,SYMBOL_LIST_SIZE(M))
|
||||
,, (BI_REF,SYMBOL_REF(M))
|
||||
,, (BI_BASE,SYMBOL_BASE(M))
|
||||
,, (BI_BASE_MEMBER,SYMBOL_BASE_MEMBER(M))
|
||||
,, (BI_FLAGS,SYMBOL_FLAGS(M))
|
||||
,, (BI_DISP,SYMBOL_DISP(M))
|
||||
,, (BI_SERIAL_NO,SYMBOL_SERIAL_NO(M))
|
||||
,, (BI_PSECT,SYMBOL_PSECT(M))
|
||||
|
||||
DATA BI_PLM_ID
|
||||
// 'LENGTH','LAST','FIRST','SIZE','MEMORY','MEMORYTOP'
|
||||
,, 'STACK','STACKTOP','STACKPTR','FRAMEPTR'
|
||||
,, 'ABS','CMPB','CMPW','DOUBLE','FINDB','FINDRB','FINDRW'
|
||||
,, 'FINDW','FIX','FLOAT','HIGH','IABS','INT','LOW'
|
||||
,, 'MOVB','MOVE','MOVRB','MOVRW','MOVW','ROL'
|
||||
,, 'ROR','SAL','SAR','SETB','SETW','SHL'
|
||||
,, 'SHR','SIGNED','SKIPB','SKIPRB','SKIPRW','SKIPW'
|
||||
,, 'UNSIGN','XLAT'
|
||||
,, '$_BYTE','$_WORD','$_INTEGER','$_POINTER','$_REAL'
|
||||
,, '$_LONG','$_DOUBLE','$_QUAD','$_SIGNED','$_UNSIGNED'
|
||||
//
|
||||
DATA BI_VAX_ID
|
||||
// '...','...','...','...','MEMORY.','MEMORY.TOP'
|
||||
,, 'S.BOT','S.','...','...'
|
||||
,, 'ABS.','CMPB.','CMPW.','...','FINDB.','FINDRB.'
|
||||
,, 'FINDRW.'
|
||||
,, 'FINDW.','...','...','HIGH.','IABS.','...','LOW.'
|
||||
,, 'MOVB.','MOVE.','MOVRB.','MOVRW.','MOVW.','ROL.'
|
||||
,, 'ROR.','SAL.','SAR.','SETB.','SETW.','SHL.'
|
||||
,, 'SHR.','...','SKIPB.','SKIPRB.','SKIPRW.','SKIPW.'
|
||||
,, '...','XLAT.'
|
||||
,, '...','...','...','...','...'
|
||||
,, '...','...','...','...','...'
|
||||
//
|
||||
DATA BI_KIND
|
||||
// 4*S_PROC,S_ARRAY,S_SCALAR
|
||||
,, S_ARRAY,S_SCALAR,S_PROC,S_PROC
|
||||
,, 7*S_PROC
|
||||
,, 7*S_PROC
|
||||
,, 6*S_PROC
|
||||
,, 6*S_PROC
|
||||
,, 6*S_PROC
|
||||
,, 2*S_PROC
|
||||
,, 5*S_PROC
|
||||
,, 5*S_PROC
|
||||
//
|
||||
DATA BI_TYPE
|
||||
// 4*S_LONG,S_BYTE,S_BYTE
|
||||
,, S_BYTE,S_BYTE,S_PTR,S_PTR
|
||||
,, S_REAL,S_WORD,S_WORD,S_WORD,S_WORD,S_WORD,S_WORD
|
||||
,, S_WORD,S_INTEGER,S_REAL,S_BYTE,S_INTEGER,S_LONG,S_BYTE
|
||||
,, 0,0,0,0,0,S_BYTE
|
||||
,, S_BYTE,S_INTEGER,S_INTEGER,0,0,S_WORD
|
||||
,, S_WORD,S_INTEGER,S_WORD,S_WORD,S_WORD,S_WORD
|
||||
,, S_WORD,0
|
||||
,, S_BYTE,S_WORD,S_INTEGER,S_PTR,S_REAL
|
||||
,, S_LONG,S_DOUBLE,S_QUAD,-1,-1
|
||||
//
|
||||
DATA BI_NBR_ELEMENTS
|
||||
// 4*0, 0, 0
|
||||
,, 0, 0, 0, 0
|
||||
,, 7*0
|
||||
,, 7*0
|
||||
,, 6*0
|
||||
,, 6*0
|
||||
,, 6*0
|
||||
,, 2*0
|
||||
,, 5*0
|
||||
,, 5*0
|
||||
//
|
||||
DATA BI_ELEMENT_SIZE
|
||||
// 4*4, 1, 1
|
||||
,, 1,1,4,4
|
||||
,, 4,2,2,2,2,2,2
|
||||
,, 2,2,4,1,2,4,1
|
||||
,, 0,0,0,0,0,1
|
||||
,, 1,2,2,0,0,2
|
||||
,, 2,2,2,2,2,2
|
||||
,, 2,0
|
||||
,, 1,2,2,4,4
|
||||
,, 4,8,8,-1,-1
|
||||
//
|
||||
DATA BI_LOWER_BOUND
|
||||
// N*0
|
||||
//
|
||||
DATA BI_LINK
|
||||
// N*0
|
||||
//
|
||||
DATA BI_LIST_SIZE
|
||||
// 4*1, 0, 0
|
||||
,, 0,0,0,0
|
||||
,, 1,3,3,1,3,3,3
|
||||
,, 3,1,1,1,1,1,1
|
||||
,, 3,3,3,3,3,2
|
||||
,, 2,2,2,3,3,2
|
||||
,, 2,1,3,3,3,3
|
||||
,, 1,4
|
||||
,, 1,1,1,1,1
|
||||
,, 1,1,1,1,1
|
||||
//
|
||||
DATA BI_REF
|
||||
// 4*S_BUILTIN, S_STATIC, S_EXT
|
||||
,, S_EXT,S_EXT,S_BUILTIN,S_BUILTIN
|
||||
,, 3*S_EXT,S_BUILTIN,3*S_EXT
|
||||
,, S_EXT,S_BUILTIN,S_BUILTIN,S_EXT,S_EXT,S_BUILTIN,S_EXT
|
||||
,, 6*S_EXT
|
||||
,, 6*S_EXT
|
||||
,, S_EXT,S_BUILTIN,4*S_EXT
|
||||
,, S_BUILTIN,S_EXT
|
||||
,, 5*S_BUILTIN
|
||||
,, 5*S_BUILTIN
|
||||
//
|
||||
DATA BI_BASE
|
||||
// N*0
|
||||
//
|
||||
DATA BI_BASE_MEMBER
|
||||
// N*0
|
||||
//
|
||||
DATA BI_FLAGS
|
||||
// 4*S_NO_SIDE_EFFECTS,S_SPECIAL,0
|
||||
,, S_SPECIAL,0,2*S_NO_SIDE_EFFECTS
|
||||
,, 7*S_NO_SIDE_EFFECTS
|
||||
,, 7*S_NO_SIDE_EFFECTS
|
||||
,, 5*0,S_NO_SIDE_EFFECTS
|
||||
,, 3*S_NO_SIDE_EFFECTS,2*0,S_NO_SIDE_EFFECTS
|
||||
,, 6*S_NO_SIDE_EFFECTS
|
||||
,, 2*S_NO_SIDE_EFFECTS
|
||||
,, 5*S_NO_SIDE_EFFECTS
|
||||
,, 5*S_NO_SIDE_EFFECTS
|
||||
//
|
||||
DATA BI_DISP
|
||||
// N*0
|
||||
//
|
||||
DATA BI_SERIAL_NO
|
||||
// N*0
|
||||
//
|
||||
DATA BI_PSECT
|
||||
// 4*0,2*P_MEMORY
|
||||
,, 2*P_STACK,2*0
|
||||
,, 7*0
|
||||
,, 7*0
|
||||
,, 6*0
|
||||
,, 6*0
|
||||
,, 6*0
|
||||
,, 2*0
|
||||
,, 5*0
|
||||
,, 5*0
|
||||
//
|
||||
PARAMETER K=54 ! # OF KEYWORDS.
|
||||
|
||||
CHARACTER*32 KW_PLM_ID(K)
|
||||
INTEGER*2 KW_KIND(K),KW_LINK(K)
|
||||
EQUIVALENCE (KW_PLM_ID,SYMBOL_PLM_ID(M+N))
|
||||
,, (KW_KIND,SYMBOL_KIND(M+N))
|
||||
,, (KW_LINK,SYMBOL_LINK(M+N))
|
||||
|
||||
DATA KW_PLM_ID
|
||||
//'ADDRESS ','AND ','AT ','BASED ','BY '
|
||||
,,'BYTE ','CALL ','CASE ','DATA ','DECLARE '
|
||||
,,'DISABLE ','DO ','ELSE ','ENABLE ','END '
|
||||
,,'EOF ','EXTERNAL ','GO ','GOTO ','HALT '
|
||||
,,'IF ','INITIAL ','INTEGER ','INTERRUPT ','LABEL '
|
||||
,,'LITERALLY ','MINUS ','MOD ','NOT ','OR '
|
||||
,,'PLUS ','POINTER ','PROCEDURE ','PUBLIC ','REAL '
|
||||
,,'REENTRANT ','RETURN ','STRUCTURE ','THEN ','TO '
|
||||
,,'WHILE ','WORD ','XOR ','COMMON ','LONG '
|
||||
,,'DOUBLEPRECISION'
|
||||
,, 'OTHERWISE ','QUAD ','FORWARD ','SELECTOR '
|
||||
,,'DWORD ','SHORT ','BOOLEAN ','REGISTER '
|
||||
//
|
||||
DATA KW_KIND
|
||||
// K*S_KEYWORD
|
||||
//
|
||||
DATA KW_LINK
|
||||
// 101,102,103,104,105,106,107,108,109,110
|
||||
,, 111,112,113,114,115,116,117,118,119,120
|
||||
,, 121,122,123,124,125,126,127,128,129,130
|
||||
,, 131,132,133,134,135,136,137,138,139,140
|
||||
,, 141,142,143,144,145,146,147,148,149,150
|
||||
,, 151,152,153,154
|
||||
//
|
||||
|
||||
SYMBOL_TOP(0)=M+N+K-1
|
||||
FIRST_KEYWORD=M+N
|
||||
|
||||
C-------- IF PLM80, DISGUISE NON-PLM80 KEYWORDS.
|
||||
C
|
||||
C IF (PLM80_FLAG) THEN
|
||||
C KW_PLM_ID(K_INTEGER-100)='$INTEGER'
|
||||
C KW_PLM_ID(K_POINTER-100)='$POINTER'
|
||||
C KW_PLM_ID(K_REAL-100)='$REAL'
|
||||
C KW_PLM_ID(K_WORD-100)='$WORD'
|
||||
C ENDIF
|
||||
|
||||
C-------- FIXUP VAX_ID'S OF BUILTINS WHICH DEPEND ON MODEL SIZE.
|
||||
|
||||
! IF (LARGE) THEN
|
||||
! MODL='L'
|
||||
! ELSE
|
||||
! MODL='S'
|
||||
! ENDIF
|
||||
!
|
||||
! DO I=1,N
|
||||
! DO J=1,32
|
||||
! IF (BI_VAX_ID(I)(J:J).EQ.'#') BI_VAX_ID(I)(J:J)=MODL
|
||||
! ENDDO
|
||||
! ENDDO
|
||||
|
||||
C-------- CHAIN BUILTINS AND KEYWORDS INTO HASH BUCKETS.
|
||||
|
||||
DO 10 I=M,SYMBOL_TOP(0)
|
||||
H=HASH(SYMBOL_PLM_ID(I))
|
||||
SYMBOL_CHAIN(I)=HASH_BUCKET(H)
|
||||
HASH_BUCKET(H)=I
|
||||
10 CONTINUE
|
||||
|
||||
C-------- READ IN GLOBAL SYMBOLS IF REQUIRED.
|
||||
|
||||
LAST_GLOBAL=0
|
||||
IF (GLOBALS_FLAG) THEN
|
||||
20 READ(GBL,1001,END=30) SYMBOL
|
||||
1001 FORMAT(X,A)
|
||||
IF (SYMBOL(1:1).NE.'*') THEN
|
||||
IF (LAST_GLOBAL.GE.GBL_MAX)
|
||||
# CALL FATAL('TOO MANY GLOBALS')
|
||||
LAST_GLOBAL=LAST_GLOBAL+1
|
||||
GLOBAL_SYMBOL(LAST_GLOBAL)=SYMBOL
|
||||
ENDIF
|
||||
GO TO 20
|
||||
30 CLOSE (UNIT=GBL)
|
||||
ENDIF
|
||||
|
||||
C-------- FIX UP PSECT NAMES AND COMPILE TIME BASES.
|
||||
|
||||
IF (MODEL.EQ.4) THEN
|
||||
PSECT_NAME(P_DATA)='$PLM_DATA'
|
||||
ENDIF
|
||||
|
||||
IF (OVERLAY_FLAG) THEN
|
||||
NC=LNB(PSECT_NAME(P_DATA))
|
||||
PSECT_NAME(P_DATA)(NC+1:)='_'
|
||||
CALL MAKE_CHARS(PSECT_NAME(P_DATA)(NC+2:),OVERLAY_PREFIX)
|
||||
|
||||
NC=LNB(PSECT_NAME(P_CODE))
|
||||
PSECT_NAME(P_CODE)(NC+1:)='_'
|
||||
CALL MAKE_CHARS(PSECT_NAME(P_CODE)(NC+2:),OVERLAY_PREFIX)
|
||||
|
||||
BASEC='D.'
|
||||
CALL MAKE_CHARS(BASEC(3:),OVERLAY_PREFIX)
|
||||
NC=LNB(BASEC)
|
||||
ENDIF
|
||||
|
||||
IF (.NOT.ROM_FLAG .AND. MODEL.NE.4) THEN
|
||||
PSECT_NAME(P_CONSTANTS)=PSECT_NAME(P_DATA)
|
||||
ENDIF
|
||||
|
||||
IF (OVERLAY_FLAG) THEN
|
||||
BASEV='R11'
|
||||
ELSE
|
||||
BASEV='#D.'
|
||||
ENDIF
|
||||
|
||||
RETURN
|
||||
END
|
||||
51
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/jpi.for
Normal file
51
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/jpi.for
Normal file
@@ -0,0 +1,51 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C JPI.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler is used to obtain job
|
||||
C statistics for compiler performance measurement and reporting.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 18OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE JPI(NTICKS,NFAULTS)
|
||||
IMPLICIT INTEGER*4 (A-Z)
|
||||
INCLUDE 'SYS$LIBRARY:JPIDEF.FOR/NOLIST'
|
||||
INTEGER*4 IL(7)
|
||||
INTEGER*2 IW(14)
|
||||
EQUIVALENCE (IL,IW)
|
||||
|
||||
DATA IW/4,JPI$_CPUTIM,0,0,0,0,4,JPI$_PAGEFLTS,0,0,0,0,0,0/
|
||||
|
||||
IL(2)=%LOC(NTICKS)
|
||||
IL(5)=%LOC(NFAULTS)
|
||||
ISS=SYS$GETJPI(,,,IL,,,)
|
||||
RETURN
|
||||
END
|
||||
154
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/list.for
Normal file
154
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/list.for
Normal file
@@ -0,0 +1,154 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C LIST.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler contains routines for listing
|
||||
C lines to the print file.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 18OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE LIST_SOURCE_LINE(LINE)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*(*) LINE
|
||||
CHARACTER*10 STRING10,S1,S2,S3
|
||||
INTEGER*4 IVAL,IFSD
|
||||
|
||||
LAST_LINE_EXISTS=.TRUE.
|
||||
|
||||
IVAL=LIST_LINE_NO+100000
|
||||
S1=STRING10(IVAL,IFSD)
|
||||
|
||||
IF (IN.EQ.8) THEN
|
||||
S2=' '
|
||||
ELSE
|
||||
IVAL=(IN-9)*10
|
||||
S2=STRING10(IVAL,IFSD)
|
||||
S2(8:8)='='
|
||||
ENDIF
|
||||
|
||||
IF (OBJECT_FLAG.AND.OPRINT_FLAG.AND.LIST_FLAG) THEN
|
||||
WRITE(OUT,1001) S1(6:10),S2(8:9),LINE
|
||||
1001 FORMAT(' ;',A5,A2,X,A)
|
||||
ENDIF
|
||||
|
||||
IF (.NOT.PRINT_FLAG .OR. .NOT.LIST_FLAG) RETURN
|
||||
|
||||
GO TO (20,10,10,20), SKIP_STATE
|
||||
10 IF (.NOT.COND_FLAG) RETURN
|
||||
20 CONTINUE
|
||||
|
||||
CALL ADVANCE_ONE_LINE
|
||||
|
||||
IF (LIST_STNO.NE.PREVIOUS_STNO.AND.LINE.NE.' '.AND.
|
||||
# LINE(LEFTMARGIN:LEFTMARGIN).NE.'$'.AND.
|
||||
# SKIP_STATE.NE.2.AND.SKIP_STATE.NE.3) THEN
|
||||
|
||||
IVAL=LIST_BLOCK_LEVEL*10
|
||||
S3=STRING10(IVAL,IFSD)
|
||||
|
||||
WRITE(LST,1002) S1(6:10),LIST_STNO,S3(8:9),S2(8:9),LINE
|
||||
1002 FORMAT(X,A5,X,I4,X,A2,X,A2,X,A)
|
||||
|
||||
PREVIOUS_STNO=LIST_STNO
|
||||
|
||||
ELSE
|
||||
WRITE(LST,1003) S1(6:10),S2(8:9),LINE
|
||||
1003 FORMAT(X,A5,9X,A2,X,A)
|
||||
ENDIF
|
||||
RETURN
|
||||
C-------------------------
|
||||
ENTRY FORCE_LIST_SOURCE
|
||||
C------------------------
|
||||
IF (.NOT.PRINT_FLAG .OR. .NOT.LIST_FLAG .OR. COND_FLAG) RETURN
|
||||
IF (.NOT.LAST_LINE_EXISTS) RETURN
|
||||
|
||||
CALL ADVANCE_ONE_LINE
|
||||
WRITE(LST,1003) S1(6:10),S2(8:9),CARD(:LNB(CARD))
|
||||
RETURN
|
||||
C----------------------------------------
|
||||
ENTRY TYPE_LAST_SOURCE_LINE
|
||||
C----------------------------------------
|
||||
IF (.NOT.LAST_LINE_EXISTS) RETURN
|
||||
|
||||
WRITE(7,1003) S1(6:10),S2(8:9),CARD(:LNB(CARD))
|
||||
RETURN
|
||||
C-------------------------------------
|
||||
ENTRY LIST_LINE(LINE)
|
||||
C-------------------------------------
|
||||
IF (.NOT.PRINT_FLAG) RETURN
|
||||
|
||||
CALL ADVANCE_ONE_LINE
|
||||
WRITE(LST,1004) LINE(:LNB(LINE))
|
||||
1004 FORMAT(X,A)
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------
|
||||
SUBROUTINE ADVANCE_ONE_LINE
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*80 TITLE,SUBTITLE,DATE
|
||||
CHARACTER*45 SOURCE_FILE
|
||||
|
||||
LINE_OF_PAGE=LINE_OF_PAGE+1
|
||||
|
||||
IF (PAGING_FLAG.AND.(EJECT_FLAG.OR.LINE_OF_PAGE.GT.PAGELENGTH))
|
||||
# THEN
|
||||
|
||||
PAGE_NO=PAGE_NO+1
|
||||
|
||||
N1=MAKE_CHARS(TITLE,TITLE_STRING)
|
||||
N2=MAKE_CHARS(SUBTITLE,SUBTITLE_STRING)
|
||||
N3=MAKE_CHARS(DATE,DATE_STRING)
|
||||
N4=MAKE_CHARS(SOURCE_FILE,IN_FILE_STRING(0,8))
|
||||
|
||||
T1=55-N1/2
|
||||
T2=55-N2/2
|
||||
T3=110-N3
|
||||
|
||||
WRITE(LST,1001) TITLE(:N1),DATE(:N3),PAGE_NO,SOURCE_FILE(:N4),
|
||||
# SUBTITLE(:N2)
|
||||
|
||||
1001 FORMAT('1PL/M-VAX COMPILER',T<T1>,A,T<T3>,A,T112,'Page ',I4/
|
||||
# X,A,T<T2>,A/)
|
||||
|
||||
EJECT_FLAG=.FALSE.
|
||||
LINE_OF_PAGE=4
|
||||
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
C--------------------------------------------------------
|
||||
SUBROUTINE ROOM_FOR(NBR_OF_LINES)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
IF (LINE_OF_PAGE+NBR_OF_LINES.GT.PAGELENGTH) EJECT_FLAG=.TRUE.
|
||||
|
||||
RETURN
|
||||
END
|
||||
59
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/locals.for
Normal file
59
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/locals.for
Normal file
@@ -0,0 +1,59 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C LOCALS.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler contains routines to
|
||||
C generate and name local labels.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 18OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
CHARACTER*32 FUNCTION LOCAL_LABEL(LL,N1)
|
||||
IMPLICIT INTEGER*2 (A-Z)
|
||||
CHARACTER*10 STRING10
|
||||
INTEGER*4 N,IFSD
|
||||
|
||||
N=LL
|
||||
LOCAL_LABEL=STRING10(N,IFSD)
|
||||
LOCAL_LABEL=LOCAL_LABEL(IFSD:10)
|
||||
N1=12-IFSD
|
||||
LOCAL_LABEL(N1:N1)='$'
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE GENERATE_LOCAL_LABEL(LL)
|
||||
IMPLICIT INTEGER*2 (A-Z)
|
||||
DATA LLN/0/
|
||||
|
||||
IF (LLN.GE.29999) CALL FATAL('LOCAL LABELS EXHAUSTED')
|
||||
LLN=LLN+1
|
||||
LL=LLN
|
||||
RETURN
|
||||
END
|
||||
@@ -0,0 +1,9 @@
|
||||
$!
|
||||
$! LOGNAMES.COM
|
||||
$!
|
||||
$! Command file to assign system-dependent logical names.
|
||||
$!
|
||||
$! 04FEB82 Alex Hunter 1. Original version.
|
||||
$!
|
||||
$ASSIGN _drb2:[plmvax.plmudi] PLM$UDI ! UDI library directory.
|
||||
$!
|
||||
@@ -0,0 +1,19 @@
|
||||
$SET VERIFY
|
||||
$! MAKETAPE.COM
|
||||
$!
|
||||
$!
|
||||
$! Command file to generate the build-it-from-source kit
|
||||
$! for the PL/M-VAX compiler. (Note that the UDI build-
|
||||
$! it-from-source kit is also required.)
|
||||
$!
|
||||
$! 02FEB82 Alex Hunter 1. Original version.
|
||||
$! 06APR82 Alex Hunter 1. Allocate MTA0 instead of MT.
|
||||
$!
|
||||
$ALLOCATE MTA0 TAPE
|
||||
$INIT/DENSITY=1600 TAPE PLMVAX
|
||||
$MOUNT TAPE PLMVAX
|
||||
$COPY/LOG *.* TAPE
|
||||
$DIR/SIZ/DAT TAPE
|
||||
$DISMOUNT TAPE
|
||||
$DEALLOCATE TAPE
|
||||
$SET NOVERIFY
|
||||
52
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/massage.for
Normal file
52
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/massage.for
Normal file
@@ -0,0 +1,52 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C MASSAGE.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler 'massages' a code tree by
|
||||
C (1) resolving signed/unsigned context of nodes, (2) coercing
|
||||
C context if needed, (3) folding constant operations, (4) merging
|
||||
C common subnodes, and (5) computing reference counts for the nodes.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 08SEP81 Alex Hunter 1. Compute reference counts. (V5.1)
|
||||
C
|
||||
C***********************************************************************
|
||||
INTEGER*2 FUNCTION MASSAGE(CODE,DEFAULT_CONTEXT)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
CALL RESOLVE_CONTEXT(CODE)
|
||||
IF (NODE_CONTEXT(CODE).EQ.0)
|
||||
# CALL SET_CONTEXT(CODE,DEFAULT_CONTEXT)
|
||||
CALL COERCE_TYPES(CODE)
|
||||
MASSAGE=FOLD_CONSTANTS(CODE)
|
||||
MASSAGE=MERGE(MASSAGE)
|
||||
CALL COMPUTE_REFERENCE_COUNTS(MASSAGE)
|
||||
RETURN
|
||||
END
|
||||
155
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/match.for
Normal file
155
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/match.for
Normal file
@@ -0,0 +1,155 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C MATCH.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler contains routines to test the
|
||||
C next token for a match. Syntax errors are detected and analyzed
|
||||
C by this module.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 18OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 28OCT81 Alex Hunter 1. Add new keywords. (V5.7)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE MATCH(TOKEN)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*32 ACTUAL1,ACTUAL2,ACTUAL3,TOKEN1,TOKEN2,TOKEN3
|
||||
|
||||
IF (TOKEN.EQ.TT) THEN
|
||||
CALL GETTOK
|
||||
RETURN
|
||||
ENDIF
|
||||
GO TO 10
|
||||
C----------------------------
|
||||
ENTRY MUSTBE(TOKEN)
|
||||
C----------------------------
|
||||
IF (TOKEN.EQ.TT) RETURN
|
||||
C
|
||||
C
|
||||
C SYNTAX ERROR......
|
||||
C
|
||||
10 CALL ANALYZE_TOKEN(TOKEN1,ACTUAL1,TOKENTYPE,FIXVAL,FLOATVAL,
|
||||
# STRLEN,DELIMITER,IDENTIFIER,STRING)
|
||||
CALL ANALYZE_TOKEN(TOKEN2,ACTUAL2,NEXT_TOKENTYPE,NEXT_FIXVAL,
|
||||
# NEXT_FLOATVAL,NEXT_STRLEN,NEXT_DELIMITER,
|
||||
# NEXT_IDENTIFIER,NEXT_STRING)
|
||||
CALL ANALYZE_TOKEN(TOKEN3,ACTUAL3,TOKEN,0,0.0,1,' ',' ',' ')
|
||||
|
||||
IF (PRINT_FLAG) THEN
|
||||
WRITE(LST,1001) ACTUAL1(:LNB(ACTUAL1)),ACTUAL2(:LNB(ACTUAL2)),
|
||||
# TOKEN3(:LNB(TOKEN3)),ACTUAL3(:LNB(ACTUAL3)),
|
||||
# TOKEN1(:LNB(TOKEN1)),ACTUAL1(:LNB(ACTUAL1))
|
||||
ENDIF
|
||||
|
||||
IF (.NOT.LISTING_TO_TERMINAL) THEN
|
||||
CALL TYPE_LAST_SOURCE_LINE
|
||||
WRITE(7,1001) ACTUAL1(:LNB(ACTUAL1)),ACTUAL2(:LNB(ACTUAL2)),
|
||||
# TOKEN3(:LNB(TOKEN3)),ACTUAL3(:LNB(ACTUAL3)),
|
||||
# TOKEN1(:LNB(TOKEN1)),ACTUAL1(:LNB(ACTUAL1))
|
||||
ENDIF
|
||||
|
||||
1001 FORMAT(/' ***** Syntax Error Near ',A,X,A,' ****'//
|
||||
# ' ***** Expected: ',A,X,A/
|
||||
# ' ***** Actually Found: ',A,X,A/)
|
||||
|
||||
STOP '**** Compilation Aborted (Syntax Error) ****'
|
||||
|
||||
END
|
||||
C------------------------------------------------------------
|
||||
SUBROUTINE ANALYZE_TOKEN(TOKEN_STRING,ACTUAL_STRING,TOKEN,
|
||||
# FIXV,FLOATV,STRL,D_STRING,ID_STRING,
|
||||
# S_STRING)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER TOKEN_STRING*32,ACTUAL_STRING*32,D_STRING*(*),
|
||||
# ID_STRING*(*),S_STRING*(*)
|
||||
INTEGER*4 FIXV
|
||||
REAL*8 FLOATV
|
||||
CHARACTER*10 KEYWORD(101:154)
|
||||
CHARACTER*2 DD(201:218)
|
||||
COMMON /ANALYZE/ KEYWORD,DD
|
||||
CHARACTER*16 NON_TERMINAL(301:303)
|
||||
DATA NON_TERMINAL /
|
||||
# '<statement>','<expression>','<type>'/
|
||||
|
||||
IF (TOKEN.EQ.INVALID) THEN
|
||||
TOKEN_STRING='<illegal character>'
|
||||
ENCODE(32,1000,ACTUAL_STRING) ICHAR(D_STRING),D_STRING(1:1)
|
||||
1000 FORMAT('X''',Z2,''' (',A1,')')
|
||||
RETURN
|
||||
|
||||
ELSEIF (TOKEN.EQ.ID) THEN
|
||||
TOKEN_STRING='<identifier>'
|
||||
ACTUAL_STRING=ID_STRING
|
||||
RETURN
|
||||
|
||||
ELSEIF (TOKEN.EQ.FIXCON) THEN
|
||||
TOKEN_STRING='<fixed point constant>'
|
||||
ENCODE(32,1001,ACTUAL_STRING) FIXV
|
||||
1001 FORMAT(I10)
|
||||
RETURN
|
||||
|
||||
ELSEIF (TOKEN.EQ.FLOATCON) THEN
|
||||
TOKEN_STRING='<floating point constant>'
|
||||
ENCODE(32,1002,ACTUAL_STRING) FLOATV
|
||||
1002 FORMAT(G14.7)
|
||||
RETURN
|
||||
|
||||
ELSEIF (TOKEN.EQ.STRCON) THEN
|
||||
TOKEN_STRING='<string constant>'
|
||||
ACTUAL_STRING=''''//S_STRING
|
||||
IF (STRL.LE.30) THEN
|
||||
ACTUAL_STRING(STRL+2:STRL+2)=''''
|
||||
ELSE
|
||||
ACTUAL_STRING(30:32)='...'
|
||||
ENDIF
|
||||
RETURN
|
||||
|
||||
ELSEIF (TOKEN.EQ.EOFTOK) THEN
|
||||
TOKEN_STRING='<eof>'
|
||||
ACTUAL_STRING=' '
|
||||
RETURN
|
||||
|
||||
ELSEIF (TOKEN.GE.101.AND.TOKEN.LE.199) THEN
|
||||
TOKEN_STRING='<keyword>'
|
||||
ACTUAL_STRING=KEYWORD(TOKEN)
|
||||
RETURN
|
||||
|
||||
ELSEIF (TOKEN.GE.201.AND.TOKEN.LE.299) THEN
|
||||
TOKEN_STRING='<delimiter>'
|
||||
ACTUAL_STRING=DD(TOKEN)
|
||||
RETURN
|
||||
|
||||
ELSE ! MUST BE NON_TERMINAL PSEUDO_TOKEN.
|
||||
|
||||
TOKEN_STRING=NON_TERMINAL(TOKEN)
|
||||
ACTUAL_STRING=' '
|
||||
RETURN
|
||||
|
||||
ENDIF
|
||||
END
|
||||
137
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/merge.for
Normal file
137
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/merge.for
Normal file
@@ -0,0 +1,137 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C MERGE.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler is used to merge identical
|
||||
C nodes of a code tree, which effectively eliminates common sub-
|
||||
C expressions. Note that after 'merging' a code tree, the code
|
||||
C 'tree' is no longer necessarily a tree, but rather a directed
|
||||
C acyclic graph. This means that the code 'tree' may no longer be
|
||||
C traversed without some form of 'node marking' to detect already-
|
||||
C visited nodes.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 18OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 21OCT81 Alex Hunter 1. Basic block analysis. (V5.5)
|
||||
C 09NOV81 Alex Hunter 1. Implement CSE assumption. (V5.9)
|
||||
C 14NOV81 Alex Hunter 1. Don't merge certain opnode ops. (V6.2)
|
||||
C 08FEB82 Alex Hunter 1. Do want to merge ARG opnodes. (V6.7)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*2 FUNCTION MERGE(NODX)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
NOD=NODX
|
||||
|
||||
IF (.NOT.ASSUME_CSE.OR.NOD.EQ.NULL.OR.CONSTANT(NOD).OR.
|
||||
# REGISTER(NOD)) THEN
|
||||
MERGE=NOD
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
IF (FIXLIT(NOD)) THEN
|
||||
DO 100 MERGE=FIX_MIN,NEXT_FIXED-1
|
||||
IF (FIXED_VAL(MERGE).EQ.FIXED_VAL(NOD).AND.
|
||||
# NODE_TYPE(MERGE).EQ.NODE_TYPE(NOD)) RETURN
|
||||
100 CONTINUE
|
||||
CALL BUG('MERGE-100')
|
||||
|
||||
ELSEIF (FLOATLIT(NOD)) THEN
|
||||
DO 200 MERGE=FLT_MIN,NEXT_FLOAT-1
|
||||
IF (FLOAT_VAL(MERGE).EQ.FLOAT_VAL(NOD).AND.
|
||||
# NODE_TYPE(MERGE).EQ.NODE_TYPE(NOD)) RETURN
|
||||
200 CONTINUE
|
||||
CALL BUG('MERGE-200')
|
||||
|
||||
ELSEIF (ATOM(NOD)) THEN
|
||||
IF (NOD.LT.FIRST_FREE_ATOM) THEN
|
||||
MERGE=NOD
|
||||
RETURN
|
||||
ENDIF
|
||||
CALL PUSH(NOD,1)
|
||||
BASE=MERGE2(ATOM_BASE(NOD))
|
||||
CALL POP(NOD,1)
|
||||
CALL PUSH(NOD,1)
|
||||
CALL PUSH(BASE,1)
|
||||
SUB=MERGE2(ATOM_SUB(NOD))
|
||||
CALL POP(BASE,1)
|
||||
CALL POP(NOD,1)
|
||||
|
||||
DO 300 MERGE=FIRST_FREE_ATOM,NEXT_ATOM-1
|
||||
IF (ATOM_SYM(MERGE).EQ.ATOM_SYM(NOD).AND.
|
||||
# ATOM_MEM(MERGE).EQ.ATOM_MEM(NOD).AND.
|
||||
# ATOM_BASE(MERGE).EQ.BASE.AND.
|
||||
# ATOM_SUB(MERGE).EQ.SUB.AND.
|
||||
# ATOM_FLAGS(MERGE).EQ.ATOM_FLAGS(NOD).AND.
|
||||
# ATOM_SERIAL_NO(MERGE).EQ.ATOM_SERIAL_NO(NOD).AND.
|
||||
# ATOM_DISP(MERGE).EQ.ATOM_DISP(NOD)) RETURN
|
||||
CCCC # NODE_TYPE(MERGE).EQ.NODE_TYPE(NOD)) RETURN
|
||||
300 CONTINUE
|
||||
|
||||
ATOM_BASE(NOD)=BASE
|
||||
ATOM_SUB(NOD)=SUB
|
||||
MERGE=NOD
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
C--------- NODE MUST BE AN OPNODE.
|
||||
|
||||
CALL PUSH(NOD,1)
|
||||
OPND1=MERGE2(OPNODE_OPND1(NOD))
|
||||
CALL POP(NOD,1)
|
||||
CALL PUSH(NOD,1)
|
||||
CALL PUSH(OPND1,1)
|
||||
OPND2=MERGE2(OPNODE_OPND2(NOD))
|
||||
CALL POP(OPND1,1)
|
||||
CALL POP(NOD,1)
|
||||
|
||||
IF (OPNODE_OP(NOD).NE.OP_MOV.AND.
|
||||
# OPNODE_OP(NOD).NE.OP_ASSN.AND.
|
||||
# OPNODE_OP(NOD).NE.OP_THEN.AND.
|
||||
# OPNODE_OP(NOD).NE.OP_ALSO)
|
||||
#THEN
|
||||
DO MERGE=NODE_MIN,NEXT_NODE-1
|
||||
IF (OPNODE_OP(MERGE).EQ.OPNODE_OP(NOD).AND.
|
||||
# OPNODE_OPND1(MERGE).EQ.OPND1.AND.
|
||||
# OPNODE_OPND2(MERGE).EQ.OPND2.AND.
|
||||
# NODE_TYPE(MERGE).EQ.NODE_TYPE(NOD)) RETURN
|
||||
ENDDO
|
||||
ENDIF
|
||||
|
||||
OPNODE_OPND1(NOD)=OPND1
|
||||
OPNODE_OPND2(NOD)=OPND2
|
||||
MERGE=NOD
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*2 FUNCTION MERGE2(NODX)
|
||||
IMPLICIT INTEGER*2 (A-Z)
|
||||
MERGE2=MERGE(NODX)
|
||||
RETURN
|
||||
END
|
||||
199
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/modules.for
Normal file
199
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/modules.for
Normal file
@@ -0,0 +1,199 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C MODULES.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler processes a (series of) PL/M
|
||||
C program modules.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 13SEP81 Alex Hunter 1. Add LONG attribute to P_DATA psect. (V5.2)
|
||||
C 21OCT81 Alex Hunter 1. Basic block analysis. (V5.5)
|
||||
C 12NOV81 Alex Hunter 1. Define APD and MEMORY psects. (V6.1)
|
||||
C 14NOV81 Alex Hunter 1. Change addressing modes and psect usage.
|
||||
C (V6.2)
|
||||
C
|
||||
C***********************************************************************
|
||||
SUBROUTINE COMPILATION
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CALL MODULE
|
||||
IF (TT.EQ.EOFTOK.OR.TT.EQ.K_EOF) RETURN
|
||||
CALL ERROR('MULTIPLE COMPILATIONS NOT CURRENTLY SUPPORTED')
|
||||
RETURN
|
||||
END
|
||||
C--------------------------------------------------------------
|
||||
SUBROUTINE MODULE
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*80 TITLE
|
||||
CHARACTER*32 MODULE_NAME,START_NAME,ID_LINE,PUBLIQUE
|
||||
INTEGER*4 NTICKS,NTICKS1,NFAULTS,NFAULTS1
|
||||
REAL*4 TIME,TIME1,CPUTIM
|
||||
INTEGER*4 HANDLE
|
||||
CHARACTER*40 REGISTER_MASK
|
||||
C
|
||||
HANDLE=0
|
||||
CALL LIB$INIT_TIMER(HANDLE)
|
||||
TIME1=SECNDS(0.0)
|
||||
CALL JPI(NTICKS1,NFAULTS1)
|
||||
IF (NLABELS.EQ.0) THEN
|
||||
CALL ERROR('MODULE NAME MISSING: MAIN. ASSUMED')
|
||||
NLABELS=1
|
||||
LABELS(NLABELS) = 'MAIN.'
|
||||
ENDIF
|
||||
|
||||
PROC_ENTRY_MASK(PROC_LEVEL)=0
|
||||
|
||||
DO I=1,NLABELS-1
|
||||
CALL ERROR('EXTRANEOUS LABEL IGNORED -- '//LABELS(I))
|
||||
ENDDO
|
||||
MODULE_NAME=PUBLIQUE(LABELS(NLABELS))
|
||||
CALL PUSHC(LABELS(NLABELS))
|
||||
CALL EMIT('.TITLE '//MODULE_NAME(:LNB(MODULE_NAME))//' '//
|
||||
# TITLE(:MAKE_CHARS(TITLE,TITLE_STRING)))
|
||||
ENCODE(32,1001,ID_LINE) VERSION
|
||||
1001 FORMAT('.IDENT "PL/M-VAX V',F3.1,'"')
|
||||
CALL EMIT(ID_LINE)
|
||||
CALL EMIT('.ENABLE GLOBAL')
|
||||
CALL EMIT('.ENABLE LOCAL_BLOCK')
|
||||
IF (DEBUG_FLAG) CALL EMIT('.ENABLE DEBUG')
|
||||
IF (PSECT_NAME(P_CONSTANTS).NE.PSECT_NAME(P_DATA)) THEN
|
||||
CALL EMIT('.PSECT '//
|
||||
# PSECT_NAME(P_CONSTANTS)(:LNB(PSECT_NAME(P_CONSTANTS)))//
|
||||
# ',RD,NOWRT,EXE,GBL,CON')
|
||||
ENDIF
|
||||
CALL EMIT('.PSECT '//
|
||||
# PSECT_NAME(P_STACK)(:LNB(PSECT_NAME(P_STACK)))//
|
||||
# ',RD,WRT,EXE,GBL,CON')
|
||||
|
||||
IF (VECTOR_FLAG) THEN
|
||||
CALL EMIT('.PSECT '//
|
||||
# PSECT_NAME(P_VECTOR)(:LNB(PSECT_NAME(P_VECTOR)))//
|
||||
# ',RD,NOWRT,EXE,GBL,CON')
|
||||
ENDIF
|
||||
|
||||
CALL EMIT('.PSECT '//
|
||||
# PSECT_NAME(P_APD)(:LNB(PSECT_NAME(P_APD)))//
|
||||
# ',RD,WRT,NOEXE,GBL,CON,LONG')
|
||||
|
||||
IF (FREQ_FLAG) THEN
|
||||
CALL EMIT('.PSECT '//
|
||||
# PSECT_NAME(P_FREQ)(:LNB(PSECT_NAME(P_FREQ)))//
|
||||
# ',RD,WRT,NOEXE,GBL,CON')
|
||||
ENDIF
|
||||
|
||||
CALL EMIT('.PSECT '//
|
||||
# PSECT_NAME(P_MEMORY)(:LNB(PSECT_NAME(P_MEMORY)))//
|
||||
# ',PIC,OVR,GBL,SHR,NOEXE,RD,WRT,LONG')
|
||||
CALL EMIT1('MEMORY.:')
|
||||
|
||||
CALL EMIT('.PSECT '//
|
||||
# PSECT_NAME(P_DATA)(:LNB(PSECT_NAME(P_DATA)))//
|
||||
# ',RD,WRT,NOEXE,GBL,CON,LONG')
|
||||
IF (MODEL.NE.4) THEN
|
||||
CALL EMIT1('K. = ^X8000')
|
||||
ENDIF
|
||||
IF (MODEL.EQ.4.AND..NOT.OVERLAY_FLAG) THEN
|
||||
CALL EMIT1('M. = .+128')
|
||||
ENDIF
|
||||
CALL EMIT('.PSECT '//
|
||||
# PSECT_NAME(P_CODE)(:LNB(PSECT_NAME(P_CODE)))//
|
||||
# ',RD,NOWRT,EXE,GBL,CON')
|
||||
NLABELS=0
|
||||
CALL MATCH(K_DO)
|
||||
CALL MATCH(D_SEMI)
|
||||
CALL BLOCK_BEGIN
|
||||
CALL DECLARATIONS
|
||||
IF (TT.NE.K_END) THEN
|
||||
CALL PSECT(P_APD)
|
||||
CALL EMIT1('FPSP. = .')
|
||||
CALL EMIT('.BLKQ 1')
|
||||
CALL PSECT(P_CODE)
|
||||
PATH=.TRUE.
|
||||
IF (OVERLAY_FLAG) THEN
|
||||
CALL EMIT1(MODULE_NAME(:LNB(MODULE_NAME))//'::')
|
||||
CALL EMIT('.WORD MSK.')
|
||||
START_NAME=' '
|
||||
ELSE
|
||||
CALL EMIT1('START.: .WORD MSK.')
|
||||
START_NAME='START.'
|
||||
ENDIF
|
||||
IF (MODEL.NE.4) THEN
|
||||
CALL EMIT('MOVL #K.,R11')
|
||||
CALL PRESERVE_REG(11)
|
||||
ELSEIF (.NOT.OVERLAY) THEN
|
||||
CALL EMIT('MOVAB M.,R11')
|
||||
CALL PRESERVE_REG(11)
|
||||
ENDIF
|
||||
IF (MODEL.EQ.1 .OR. MODEL.EQ.3) THEN
|
||||
CALL EMIT('MOVAB S.,R10')
|
||||
CALL PRESERVE_REG(10)
|
||||
ENDIF
|
||||
CALL EMIT('MOVQ FP,FPSP.')
|
||||
|
||||
CALL UNITS
|
||||
CALL BREAK
|
||||
|
||||
IF (PATH) THEN
|
||||
CALL EMIT('MOVL #1,R0')
|
||||
CALL EMIT('RET')
|
||||
ENDIF
|
||||
|
||||
CALL EMIT1('MSK. = '//
|
||||
# REGISTER_MASK(PROC_ENTRY_MASK(PROC_LEVEL)))
|
||||
ELSE
|
||||
START_NAME=' '
|
||||
ENDIF
|
||||
|
||||
CALL OUTPUT_PUBLICS(MODULE_NAME)
|
||||
|
||||
CALL BLOCK_END
|
||||
CALL END_STATEMENT
|
||||
|
||||
IF (SKIP_STATE.NE.4) THEN
|
||||
CALL ERROR('$ENDIF MISSING AT END OF COMPILATION')
|
||||
ENDIF
|
||||
|
||||
CALL EMIT('.END '//START_NAME)
|
||||
|
||||
IF (PRINT_FLAG) THEN
|
||||
CALL SUMMARY_TAIL
|
||||
CALL ROOM_FOR(8)
|
||||
CALL ADVANCE_ONE_LINE
|
||||
TIME=SECNDS(TIME1)
|
||||
CALL JPI(NTICKS,NFAULTS)
|
||||
CPUTIM=(NTICKS-NTICKS1)*.01
|
||||
WRITE(LST,1000) CPUTIM,TIME,NFAULTS-NFAULTS1
|
||||
1000 FORMAT(//' PL/M-VAX COMPILATION STATISTICS'//
|
||||
# ' CPU Time:',T21,F8.2' seconds'/
|
||||
# ' Elapsed Time:'T21,F8.2' seconds'/
|
||||
# ' Page Faults:'T21,I8)
|
||||
ENDIF
|
||||
CALL LIB$SHOW_TIMER(HANDLE)
|
||||
RETURN
|
||||
END
|
||||
192
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/nodes.for
Normal file
192
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/nodes.for
Normal file
@@ -0,0 +1,192 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C NODES.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler contains routines to create
|
||||
C nodes of a code tree, and to determine the type of a node.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 20OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 21OCT81 Alex Hunter 1. Basic block analysis. (V5.5)
|
||||
C 10NOV81 Alex Hunter 1. Add serial no. deltas. (6.0)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*2 FUNCTION MAKE_NODE(OP,OPND1,OPND2,TYPE,REG,REFCT)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
REAL*8 RVAL
|
||||
INTEGER*4 IVAL,IVAL1
|
||||
IF (NEXT_NODE.GT.NODE_MAX) CALL FATAL('NODE TABLE OVERFLOW')
|
||||
OPNODE_OP(NEXT_NODE)=OP
|
||||
OPNODE_OPND1(NEXT_NODE)=OPND1
|
||||
OPNODE_OPND2(NEXT_NODE)=OPND2
|
||||
NODE_TYPE(NEXT_NODE)=TYPE
|
||||
NODE_REG(NEXT_NODE)=REG
|
||||
NODE_REFCT(NEXT_NODE)=0
|
||||
NODE_CONTEXT(NEXT_NODE)=0
|
||||
MAKE_NODE=NEXT_NODE
|
||||
NEXT_NODE=NEXT_NODE+1
|
||||
RETURN
|
||||
C---------------------------------------
|
||||
ENTRY MAKE_ATOM(SYM,MEM,BASE,SUBSCRIPT,TYPE,REG,REFCT)
|
||||
C---------------------------------------
|
||||
IF (NEXT_ATOM.GT.ATOM_MAX) CALL FATAL('ATOM TABLE OVERFLOW')
|
||||
ATOM_SYM(NEXT_ATOM)=SYM
|
||||
ATOM_MEM(NEXT_ATOM)=MEM
|
||||
ATOM_BASE(NEXT_ATOM)=BASE
|
||||
ATOM_SUB(NEXT_ATOM)=SUBSCRIPT
|
||||
ATOM_DISP(NEXT_ATOM)=0
|
||||
ATOM_FLAGS(NEXT_ATOM)=0
|
||||
NODE_TYPE(NEXT_ATOM)=TYPE
|
||||
NODE_REG(NEXT_ATOM)=REG
|
||||
NODE_REFCT(NEXT_ATOM)=0
|
||||
NODE_CONTEXT(NEXT_ATOM)=CONTEXT(TYPE)
|
||||
IF (MEM.NE.0) THEN
|
||||
ATOM_SERIAL_NO(NEXT_ATOM)=MEMBER_SERIAL_NO(MEM)
|
||||
ELSEIF (SYM.NE.0) THEN
|
||||
ATOM_SERIAL_NO(NEXT_ATOM)=SYMBOL_SERIAL_NO(SYM)
|
||||
ELSE
|
||||
ATOM_SERIAL_NO(NEXT_ATOM)=-1
|
||||
ENDIF
|
||||
IF (SYM.NE.0.AND.SYMBOL_REF(SYM).EQ.S_EXT) THEN
|
||||
ATOM_SERIAL_NO(NEXT_ATOM) =
|
||||
# ATOM_SERIAL_NO(NEXT_ATOM) + EXTERNAL_SERIAL_DELTA
|
||||
ENDIF
|
||||
IF (BASE.NE.NULL) THEN
|
||||
ATOM_SERIAL_NO(NEXT_ATOM) =
|
||||
# ATOM_SERIAL_NO(NEXT_ATOM) + BASED_SERIAL_DELTA
|
||||
ENDIF
|
||||
IF (SUBSCRIPT.NE.NULL) THEN
|
||||
ATOM_SERIAL_NO(NEXT_ATOM) =
|
||||
# ATOM_SERIAL_NO(NEXT_ATOM) + SUBSCRIPTED_SERIAL_DELTA
|
||||
ENDIF
|
||||
IF ((SYMBOL_FLAGS(SYM).AND.S_OVERLAID).NE.0) THEN
|
||||
ATOM_SERIAL_NO(NEXT_ATOM) =
|
||||
# ATOM_SERIAL_NO(NEXT_ATOM) + OVERLAID_SERIAL_DELTA
|
||||
ENDIF
|
||||
MAKE_ATOM=NEXT_ATOM
|
||||
NEXT_ATOM=NEXT_ATOM+1
|
||||
RETURN
|
||||
C---------------------------------------
|
||||
ENTRY MAKE_FIXED(IVAL,TYPE)
|
||||
C---------------------------------------
|
||||
IVAL1=IVAL
|
||||
GO TO 10
|
||||
C---------------------------------------
|
||||
ENTRY MAKE_FIXED2(I2VAL,TYPE)
|
||||
C---------------------------------------
|
||||
IVAL1=I2VAL
|
||||
10 IF (NEXT_FIXED.GT.FIX_MAX)
|
||||
# CALL FATAL('FIXED POINT LITERAL TABLE OVERFLOW')
|
||||
FIXED_VAL(NEXT_FIXED)=IVAL1
|
||||
NODE_TYPE(NEXT_FIXED)=TYPE
|
||||
NODE_REG(NEXT_FIXED)=0
|
||||
NODE_REFCT(NEXT_FIXED)=0
|
||||
IF (TYPE.EQ.0) THEN
|
||||
NODE_CONTEXT(NEXT_FIXED)=0
|
||||
ELSEIF (TYPE.EQ.S_INTEGER) THEN
|
||||
NODE_CONTEXT(NEXT_FIXED)=CX_SIGNED
|
||||
ELSE
|
||||
NODE_CONTEXT(NEXT_FIXED)=CX_UNSIGNED
|
||||
ENDIF
|
||||
MAKE_FIXED=NEXT_FIXED
|
||||
NEXT_FIXED=NEXT_FIXED+1
|
||||
RETURN
|
||||
C---------------------------------------
|
||||
ENTRY MAKE_FLOAT(RVAL,TYPE)
|
||||
C---------------------------------------
|
||||
IF (NEXT_FLOAT.GT.FLT_MAX)
|
||||
# CALL FATAL('FLOATING POINT LITERAL TABLE OVERFLOW')
|
||||
FLOAT_VAL(NEXT_FLOAT)=RVAL
|
||||
NODE_TYPE(NEXT_FLOAT)=TYPE
|
||||
NODE_REG(NEXT_FLOAT)=0
|
||||
NODE_REFCT(NEXT_FLOAT)=0
|
||||
NODE_CONTEXT(NEXT_FLOAT)=CX_SIGNED
|
||||
MAKE_FLOAT=NEXT_FLOAT
|
||||
NEXT_FLOAT=NEXT_FLOAT+1
|
||||
RETURN
|
||||
C---------------------------------------
|
||||
ENTRY MAKE_CONSTANT(LL,TYPE)
|
||||
C---------------------------------------
|
||||
IF (NEXT_CONSTANT.GT.CON_MAX)
|
||||
# CALL FATAL('CONSTANT TABLE OVERFLOW')
|
||||
CONSTANT_LABEL(NEXT_CONSTANT)=LL
|
||||
NODE_TYPE(NEXT_CONSTANT)=TYPE
|
||||
NODE_REG(NEXT_CONSTANT)=0
|
||||
NODE_REFCT(NEXT_CONSTANT)=0
|
||||
NODE_CONTEXT(NEXT_CONSTANT)=CONTEXT(TYPE)
|
||||
MAKE_CONSTANT=NEXT_CONSTANT
|
||||
NEXT_CONSTANT=NEXT_CONSTANT+1
|
||||
RETURN
|
||||
C---------------------------------------
|
||||
ENTRY MAKE_REGISTER(REG,TYPE)
|
||||
C---------------------------------------
|
||||
NODE_TYPE(REG)=TYPE
|
||||
NODE_REG(REG)=REG
|
||||
NODE_REFCT(REG)=0
|
||||
NODE_CONTEXT(REG)=CONTEXT(TYPE)
|
||||
MAKE_REGISTER=REG
|
||||
RETURN
|
||||
END
|
||||
C--------------------------------------------------------------
|
||||
FUNCTION NODE(LINK)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
NODE=LINK.GE.NODE_MIN.AND.LINK.LE.NODE_MAX
|
||||
RETURN
|
||||
C---------------------------------------
|
||||
ENTRY ATOM(LINK)
|
||||
C---------------------------------------
|
||||
ATOM=LINK.GE.ATOM_MIN.AND.LINK.LE.ATOM_MAX
|
||||
RETURN
|
||||
C---------------------------------------
|
||||
ENTRY LITERAL(LINK)
|
||||
C---------------------------------------
|
||||
LITERAL=LINK.GE.FIX_MIN.AND.LINK.LE.FIX_MAX.OR.
|
||||
# LINK.GE.FLT_MIN.AND.LINK.LE.FLT_MAX
|
||||
RETURN
|
||||
C---------------------------------------
|
||||
ENTRY FIXLIT(LINK)
|
||||
C---------------------------------------
|
||||
FIXLIT=LINK.GE.FIX_MIN.AND.LINK.LE.FIX_MAX
|
||||
RETURN
|
||||
C---------------------------------------
|
||||
ENTRY FLOATLIT(LINK)
|
||||
C---------------------------------------
|
||||
FLOATLIT=LINK.GE.FLT_MIN.AND.LINK.LE.FLT_MAX
|
||||
RETURN
|
||||
C---------------------------------------
|
||||
ENTRY CONSTANT(LINK)
|
||||
C---------------------------------------
|
||||
CONSTANT=LINK.GE.CON_MIN.AND.LINK.LE.CON_MAX
|
||||
RETURN
|
||||
C---------------------------------------
|
||||
ENTRY REGISTER(LINK)
|
||||
C---------------------------------------
|
||||
REGISTER=LINK.GE.REG_MIN.AND.LINK.LE.REG_MAX
|
||||
RETURN
|
||||
END
|
||||
79
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/open.for
Normal file
79
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/open.for
Normal file
@@ -0,0 +1,79 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C OPEN.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler contains routines used to
|
||||
C open input and output files. A 'USEROPEN' procedure is invoked
|
||||
C when an input file is opened to allow access to the VFC line
|
||||
C numbers created by text editors.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 20OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 04FEB82 Alex Hunter 1. Change name of useropen procedure
|
||||
C and its common block. (V6.6)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE OPEN_SOS_FILE(UNIT,FILE_STRING)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
EXTERNAL XQ_GET_CNTRL_FLD
|
||||
BYTE FILE_STRING(0:45)
|
||||
INTEGER*2 W_LINE_NUMBER(0:99)
|
||||
COMMON /XQ_LINE_SEQS/ W_LINE_NUMBER
|
||||
|
||||
FILE_STRING(FILE_STRING(0)+1)=0
|
||||
W_LINE_NUMBER(UNIT)=-1
|
||||
I=1
|
||||
IF (FILE_STRING(1).EQ.':') I=2
|
||||
|
||||
OPEN(UNIT=UNIT,FILE=FILE_STRING(I),STATUS='OLD',READONLY,
|
||||
# USEROPEN=XQ_GET_CNTRL_FLD,ERR=99)
|
||||
RETURN
|
||||
|
||||
99 IF (PRINT_FLAG) THEN
|
||||
CALL ADVANCE_ONE_LINE
|
||||
WRITE(LST,1000) (FILE_STRING(I),I=1,FILE_STRING(0))
|
||||
ENDIF
|
||||
IF (.NOT.LISTING_TO_TERMINAL) THEN
|
||||
CALL TYPE_LAST_SOURCE_LINE
|
||||
WRITE(7,1000) (FILE_STRING(I),I=1,FILE_STRING(0))
|
||||
ENDIF
|
||||
1000 FORMAT(' **** Input File Not Found: ',99A1)
|
||||
STOP 'COMPILATION ABORTED'
|
||||
|
||||
C----------------------------------
|
||||
ENTRY OPEN_OUTPUT_FILE(UNIT,FILE_STRING)
|
||||
C----------------------------------
|
||||
FILE_STRING(FILE_STRING(0)+1)=0
|
||||
I=1
|
||||
IF (FILE_STRING(1).EQ.':') I=2
|
||||
|
||||
OPEN(UNIT=UNIT,FILE=FILE_STRING(I),STATUS='NEW')
|
||||
|
||||
RETURN
|
||||
END
|
||||
248
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/operand.for
Normal file
248
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/operand.for
Normal file
@@ -0,0 +1,248 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C OPERAND.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler is used to translate a
|
||||
C code tree operand into a symbolic assembly-language character
|
||||
C string.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 20OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 2. Generate long-displacement addressing
|
||||
C for constants in ROM.
|
||||
C 12NOV81 Alex Hunter 1. Qualify S_STATIC with P_DATA. (V6.1)
|
||||
C 14NOV81 Alex Hunter 1. Major rewrite to change addressing modes.
|
||||
C (V6.2)
|
||||
C 03FEB82 Alex Hunter 1. Fix bug for immediate operands in LARGE
|
||||
C model. (V6.6)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
CHARACTER*80 FUNCTION OPERAND(OPND,N)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
INTEGER*4 IVAL,IFSD,ILSD
|
||||
CHARACTER*32 VECNIQUE
|
||||
CHARACTER*14 STRINGG,LITG
|
||||
CHARACTER*10 LIT,STRING10
|
||||
CHARACTER*2 DISPL
|
||||
CHARACTER*3 REGNAME(REG_MIN:REG_MAX)
|
||||
DATA REGNAME /'R1','R2','R3','R4','R5','R6','R7','R8','R9',
|
||||
# 'R10','R11','AP','FP','SP','PC','R0'/
|
||||
INTEGER*2 REGNAME_LENGTH(REG_MIN:REG_MAX)
|
||||
DATA REGNAME_LENGTH /2,2,2,2,2,2,2,2,2,3,3,2,2,2,2,2/
|
||||
|
||||
IF (OPND.GE.REG_MIN.AND.OPND.LE.REG_MAX) THEN
|
||||
OPERAND=REGNAME(OPND)
|
||||
N=REGNAME_LENGTH(OPND)
|
||||
RETURN
|
||||
|
||||
ELSEIF (OPND.EQ.ON_STACK) THEN
|
||||
IF (MODEL.EQ.2 .OR. MODEL.EQ.4) THEN
|
||||
OPERAND='-(SP)'
|
||||
N=5
|
||||
ELSE
|
||||
OPERAND='-(R10)'
|
||||
N=6
|
||||
ENDIF
|
||||
RETURN
|
||||
|
||||
ELSEIF (FIXLIT(OPND)) THEN
|
||||
IVAL=FIXED_VAL(OPND)
|
||||
LIT=STRING10(IVAL,IFSD)
|
||||
OPERAND='#'//LIT(IFSD:10)
|
||||
N=12-IFSD
|
||||
RETURN
|
||||
|
||||
ELSEIF (FLOATLIT(OPND)) THEN
|
||||
LITG=STRINGG(FLOAT_VAL(OPND),IFSD,ILSD)
|
||||
OPERAND='#'//LITG(IFSD:ILSD)
|
||||
N=ILSD-IFSD+2
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
C -- OPERAND MUST BE A CONSTANT OR AN ATOM.
|
||||
|
||||
C
|
||||
C --- COMPUTE WHICH ADDRESSING SCHEMA TO USE.
|
||||
C
|
||||
SCHEMA=1 ! Default schema.
|
||||
ATMSYM=0 ! In case opnd is a constant.
|
||||
|
||||
IF (CONSTANT(OPND)) THEN
|
||||
IF (ROM_FLAG.OR.MODEL.EQ.4) THEN
|
||||
SCHEMA=3
|
||||
ELSEIF (OVERLAY_FLAG) THEN
|
||||
SCHEMA=7
|
||||
ELSE
|
||||
SCHEMA=5
|
||||
ENDIF
|
||||
ELSEIF (ATOM(OPND)) THEN
|
||||
ATMSYM=ATOM_SYM(OPND) ! We'll need this a lot.
|
||||
IF ((ATOM_FLAGS(OPND).AND.A_VECTOR).NE.0) THEN
|
||||
SCHEMA=4
|
||||
ELSEIF (ATOM_BASE(OPND).NE.0) THEN
|
||||
SCHEMA=2
|
||||
BASEREG=NODE_REG(ATOM_BASE(OPND))
|
||||
ELSEIF (ATMSYM.NE.0) THEN
|
||||
IF (SYMBOL_REF(ATMSYM).EQ.S_STATIC) THEN
|
||||
IF (SYMBOL_PSECT(ATMSYM).EQ.P_DATA) THEN
|
||||
IF (OVERLAY_FLAG) THEN
|
||||
SCHEMA=7
|
||||
ELSE
|
||||
SCHEMA=5
|
||||
ENDIF
|
||||
ELSEIF (SYMBOL_PSECT(ATMSYM).EQ.P_CONSTANT) THEN
|
||||
SCHEMA=3
|
||||
ELSEIF (SYMBOL_PSECT(ATMSYM).EQ.P_MEMORY) THEN
|
||||
SCHEMA=8
|
||||
ELSEIF (SYMBOL_PSECT(ATMSYM).GT.P_MEMORY) THEN
|
||||
SCHEMA=3 ! User common.
|
||||
ENDIF
|
||||
ELSEIF (SYMBOL_REF(ATMSYM).EQ.S_EXT) THEN
|
||||
IF (SYMBOL_PSECT(ATMSYM).EQ.P_DATA) THEN
|
||||
IF ((SYMBOL_FLAGS(ATMSYM).AND.S_SAME_OVERLAY).NE.0)
|
||||
# THEN
|
||||
SCHEMA=7
|
||||
ELSE
|
||||
SCHEMA=6
|
||||
ENDIF
|
||||
ELSEIF (SYMBOL_PSECT(ATMSYM).EQ.P_CONSTANT) THEN
|
||||
SCHEMA=3
|
||||
ELSEIF (SYMBOL_PSECT(ATMSYM).EQ.P_MEMORY) THEN
|
||||
SCHEMA=8
|
||||
ELSEIF (SYMBOL_PSECT(ATMSYM).GT.P_MEMORY) THEN
|
||||
SCHEMA=3 ! User common.
|
||||
ENDIF
|
||||
ELSEIF (SYMBOL_REF(ATMSYM).EQ.S_ARG) THEN
|
||||
SCHEMA=2
|
||||
BASEREG=PROC_AP(SYMBOL_LINK(ATMSYM))
|
||||
ELSEIF (SYMBOL_REF(ATMSYM).EQ.S_DYNAMIC) THEN
|
||||
SCHEMA=2
|
||||
BASEREG=12
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
C
|
||||
C --- COMPUTE THE DISPLACEMENT MODE FIELD.
|
||||
C
|
||||
IF (ATOM(OPND).AND.(ATOM_FLAGS(OPND).AND.A_IMMEDIATE).NE.0 .OR.
|
||||
# ATMSYM.NE.0.AND.SYMBOL_REF(ATMSYM).EQ.S_VALUE) THEN
|
||||
OPERAND='#'
|
||||
N=1
|
||||
ELSEIF (SCHEMA.GE.5.AND.MODEL.NE.4.AND.
|
||||
# .NOT.(MODEL.EQ.2.AND.SCHEMA.EQ.8)) THEN
|
||||
OPERAND='W^'
|
||||
N=2
|
||||
ELSE
|
||||
OPERAND=' '
|
||||
N=0
|
||||
ENDIF
|
||||
|
||||
C
|
||||
C --- COMPUTE THE SYMBOLIC VALUE FIELD.
|
||||
C
|
||||
IF (CONSTANT(OPND)) THEN
|
||||
OPERAND(N+1:)=LOCAL_LABEL(CONSTANT_LABEL(OPND),N1)
|
||||
N=N+N1
|
||||
ELSEIF (SCHEMA.EQ.4) THEN
|
||||
OPERAND(N+1:)=VECNIQUE(SYMBOL_VAX_ID(ATMSYM))
|
||||
N=LNB(OPERAND)
|
||||
ELSE
|
||||
IF (ATMSYM.NE.0) THEN
|
||||
OPERAND(N+1:)=SYMBOL_VAX_ID(ATMSYM)
|
||||
N=LNB(OPERAND)
|
||||
ENDIF
|
||||
IF (ATOM_MEM(OPND).NE.0) THEN
|
||||
OPERAND(N+1:)='+'//MEMBER_VAX_ID(ATOM_MEM(OPND))
|
||||
N=LNB(OPERAND)
|
||||
ENDIF
|
||||
IVAL=ATOM_DISP(OPND)
|
||||
IF (ATMSYM.NE.0) THEN
|
||||
IVAL=IVAL+SYMBOL_DISP(ATMSYM)
|
||||
ENDIF
|
||||
IF (IVAL.NE.0) THEN
|
||||
LIT=STRING10(IVAL,IFSD)
|
||||
IF (IVAL.GE.0) THEN
|
||||
OPERAND(N+1:)='+'//LIT(IFSD:10)
|
||||
N=N+12-IFSD
|
||||
ELSE
|
||||
OPERAND(N+1:)=LIT(IFSD:10)
|
||||
N=N+11-IFSD
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
C
|
||||
C --- COMPUTE RUNTIME RELOCATION FIELD.
|
||||
C
|
||||
IF (SCHEMA.EQ.7.AND.
|
||||
# (.NOT.ATOM(OPND).OR.(ATOM_FLAGS(OPND).AND.A_CTIM).EQ.0)) THEN
|
||||
OPERAND(N+1:)='-'//BASEC
|
||||
N=N+NC+1
|
||||
ENDIF
|
||||
|
||||
C
|
||||
C --- COMPUTE THE BASE FIELD.
|
||||
C
|
||||
IF (SCHEMA.EQ.2) THEN
|
||||
OPERAND(N+1:)='('//REGNAME(BASEREG)(:REGNAME_LENGTH(BASEREG))
|
||||
# //')'
|
||||
N=N+REGNAME_LENGTH(BASEREG)+2
|
||||
ELSEIF (SCHEMA.EQ.4) THEN
|
||||
OPERAND(N+1:)='-V.'
|
||||
N=N+3
|
||||
ELSEIF (SCHEMA.GE.5.AND.MODEL.NE.4.AND.
|
||||
# .NOT.(MODEL.EQ.2.AND.SCHEMA.EQ.8)) THEN
|
||||
IF (.NOT.ATOM(OPND).OR.(ATOM_FLAGS(OPND).AND.A_IMMEDIATE).EQ.0)
|
||||
# THEN
|
||||
OPERAND(N+1:)='-K.(R11)'
|
||||
N=N+8
|
||||
ENDIF
|
||||
ELSEIF (SCHEMA.EQ.5.AND.MODEL.EQ.4) THEN
|
||||
IF (.NOT.ATOM(OPND).OR.(ATOM_FLAGS(OPND).AND.A_IMMEDIATE).EQ.0)
|
||||
# THEN
|
||||
OPERAND(N+1:)='(R11)'
|
||||
N=N+5
|
||||
ELSE
|
||||
OPERAND(N+1:)='+M.'
|
||||
N=N+3
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
C
|
||||
C --- COMPUTE THE INDEX FIELD.
|
||||
C
|
||||
IF (ATOM(OPND).AND.ATOM_SUB(OPND).NE.NULL) THEN
|
||||
XREG=NODE_REG(ATOM_SUB(OPND))
|
||||
OPERAND(N+1:)='['//REGNAME(XREG)(:REGNAME_LENGTH(XREG))//']'
|
||||
N=N+REGNAME_LENGTH(XREG)+2
|
||||
ENDIF
|
||||
|
||||
RETURN
|
||||
END
|
||||
17
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/plm.bld
Normal file
17
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/plm.bld
Normal file
@@ -0,0 +1,17 @@
|
||||
$SET VERIFY
|
||||
$!
|
||||
$! PLM.BLD
|
||||
$!
|
||||
$! Command file to build the PL/M-VAX compiler.
|
||||
$!
|
||||
$! 02FEB82 Alex Hunter 1. Original version.
|
||||
$!
|
||||
$!
|
||||
$! 1. Compile all source modules.
|
||||
$!
|
||||
$@PLM.CMP
|
||||
$!
|
||||
$! 2. Link everything together.
|
||||
$!
|
||||
$@PLM.LNK
|
||||
$SET NOVERIFY
|
||||
75
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/plm.cmp
Normal file
75
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/plm.cmp
Normal file
@@ -0,0 +1,75 @@
|
||||
$SET VERIFY
|
||||
$!
|
||||
$! PLM.CMP
|
||||
$!
|
||||
$!
|
||||
$! Command file to compile all the modules of the PL/M-VAX compiler.
|
||||
$!
|
||||
$! 02FEB82 Alex Hunter 1. Original version.
|
||||
$! 05FEB82 Alex Hunter 1. Add call to LOGNAMES.COM.
|
||||
$!
|
||||
$@LOGNAMES
|
||||
$!
|
||||
$FOR/DEB/NOCHECK/CONT=99 BASICS.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 BLOCK.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 BRANCHES.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 BREAK.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 BUILTINS.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 COERCE.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 CONTEXT.FOR
|
||||
$PLM CONTROL.PLM DEBUG OPTIMIZE(3) ALIGN
|
||||
$FOR/DEB/NOCHECK/CONT=99 COUNTS.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 DATA.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 DECLS.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 EFFECTS.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 EMIT.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 ERROR.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 EXPRS.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 FOLD.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 GENCODE.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 GETC.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 GETLEX.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 GETTOK.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 HASH.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 INIT.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 JPI.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 LIST.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 LOCALS.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 MASSAGE.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 MATCH.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 MERGE.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 MODULES.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 NODES.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 OPEN.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 OPERAND.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 PLM.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 PROCS.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 PSECTS.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 PUBLICS.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 PUSH.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 REGS.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 REPLICA.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 SAVETREE.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 SCOPES.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 SOMEWHERE.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 STRINGS.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 SUMMARY.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 SYMTAB.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 UNIQUE.FOR
|
||||
$FOR/DEB/NOCHECK/CONT=99 UNITS.FOR
|
||||
$!
|
||||
$LIB/CRE PLMCOM
|
||||
$LIB PLMCOM BASICS,BLOCK,BRANCHES,BREAK,BUILTINS
|
||||
$LIB PLMCOM COERCE,CONTEXT,CONTROL,COUNTS
|
||||
$LIB PLMCOM DATA,DECLS
|
||||
$LIB PLMCOM EFFECTS,EMIT,ERROR,EXPRS,FOLD
|
||||
$LIB PLMCOM GENCODE,GETC,GETLEX,GETTOK
|
||||
$LIB PLMCOM HASH,INIT,JPI
|
||||
$LIB PLMCOM LIST,LOCALS
|
||||
$LIB PLMCOM MASSAGE,MATCH,MERGE,MODULES
|
||||
$LIB PLMCOM NODES,OPEN,OPERAND
|
||||
$LIB PLMCOM PLM,PROCS,PSECTS,PUBLICS,PUSH
|
||||
$LIB PLMCOM REGS,REPLICA
|
||||
$LIB PLMCOM SAVETREE,SCOPES,SOMEWHERE
|
||||
$LIB PLMCOM STRINGS,SUMMARY,SYMTAB
|
||||
$LIB PLMCOM UNIQUE,UNITS
|
||||
356
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/plm.for
Normal file
356
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/plm.for
Normal file
@@ -0,0 +1,356 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C PLM.FOR
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This is the main module for the PL/M-VAX compiler. Default values
|
||||
C for controls are established, the invocation line is processed, a
|
||||
C compilation is performed, and the MACRO assembler is chained to
|
||||
C (if required).
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C VERSION 3.5 29APR81 AFH FOR MODEL=1 (SMALL) ASSUME D.=0,
|
||||
C AND MAKE APPROPRIATE SIMPLIFICATIONS.
|
||||
C
|
||||
C VERSION 3.6 30APR81 AFH IMPLEMENT PROCEDURE EXECUTION FREQUENCY
|
||||
C COUNTS
|
||||
C
|
||||
C VERSION 3.7 08MAY81 AFH FIXED BUG IN CONTROL_LINE PROCEDURE
|
||||
C WHICH COULD SOMETIMES CAUSE A CONTROL
|
||||
C LINE TO BE IGNORED. ALSO, CHECK
|
||||
C SKIP_STATE AT END OF COMPILATION TO
|
||||
C DETECT UNCLOSED CONDITIONAL COMPILATION
|
||||
C BLOCKS.
|
||||
C
|
||||
C VERSION 3.8 14MAY81 AFH 1. Special handling for DO WHILE <const>
|
||||
C (eliminates some spurious PATH warnings).
|
||||
C 2. Fix invocation line bug introduced in
|
||||
C version 3.7.
|
||||
C 3. Allow spurious trailing comma in
|
||||
C initialization list (for compatibility
|
||||
C with PLM86).
|
||||
C 4. Put runtime statistics at end of listing.
|
||||
C 5. Fix node_type(reg) bug in SOMEWHERE.
|
||||
C 6. Set attributes of all symbols in a
|
||||
C factored declaration before processing
|
||||
C the initialization list (in case list
|
||||
C contains restricted location refs to
|
||||
C any elements in the current declaration).
|
||||
C
|
||||
C VERSION 3.9 AFH 15MAY81 1. Add STACK,STACKTOP,STACKPTR builtins.
|
||||
C 2. Change default extent for PUBLICS to PBL.
|
||||
C 3. Fix line #'s for unsequenced INCLUDE
|
||||
C files.
|
||||
C
|
||||
C VERSION 4.0 AFH 28MAY81 (FIRST RELEASE TO INTEL.)
|
||||
C 1. No traceback on FATAL error or BUG.
|
||||
C 2. Fix 'input file not found' message
|
||||
C to come out on terminal.
|
||||
C 3. Try to type offending source line
|
||||
C along with error message to terminal.
|
||||
C
|
||||
C VERSION 4.1 AFH 14JUN81 1. Increase string space to 32K bytes.
|
||||
C 2. Don't allow procedure as LHS of
|
||||
C assignment statement.
|
||||
C
|
||||
C VERSION 4.2 AFH 22JUN81 1. Temporary fix to allow dimensions>32K.
|
||||
C
|
||||
C VERSION 4.3 AFH 23JUN81 (SECOND RELEASE TO INTEL.)
|
||||
C 1. Fix LAST,LENGTH,SIZE for dimension>32K.
|
||||
C 2. Generate in-line code for the following
|
||||
C built-ins:
|
||||
C DOUBLE,LOW,FLOAT,FIX,INT,SIGNED,
|
||||
C UNSIGN.
|
||||
C
|
||||
C VERSION 4.4 AFH 23JUN81 (THIRD RELEASE TO INTEL.)
|
||||
C 1. Allow AT(@external+offset).
|
||||
C
|
||||
C VERSION 4.5 AFH 05JUL81 1. Implement ACALLS control.
|
||||
C 2. Only two models (LARGE & SMALL),
|
||||
C so make some simplifications.
|
||||
C 3. Change FIND* library routine names
|
||||
C to the unified versions.
|
||||
C 4. Change most D.'s to 0's.
|
||||
C 5. Generate 'MCOMB #0' instead of
|
||||
C 'MNEGB #1' for aesthetic reasons.
|
||||
C 6. Generate word-displacement addressing
|
||||
C for SMALL-model constants.
|
||||
C (Modules affected: PLMCOM, PLM, CONTROL,
|
||||
C PROCS, BASICS, LOCALS, MODULES, INIT,
|
||||
C EMIT, FOLD, GENCODE, OPERAND.)
|
||||
C
|
||||
C VERSION 4.6 AFH 05JUL81 1. Allow %forward references in restricted
|
||||
C location references.
|
||||
C 2. Add ALIGN, FREQUENCIES, ACALLS to
|
||||
C summary tail.
|
||||
C
|
||||
C VERSION 4.7 AFH 16JUL81 1. Correct bug introduced by 4.5(6.).
|
||||
C (addressing was wrong for SMALL model
|
||||
C non-overlay module constants).
|
||||
C (Modules affected: PLM, OPERAND.)
|
||||
C
|
||||
C VERSION 4.8 AFH 29JUL81 1. Add FRAME$PTR builtin.
|
||||
C (Modules affected: PLM, INIT, BUILTINS.)
|
||||
C
|
||||
C VERSION 4.9 AFH 18AUG81 (FIFTH RELEASE TO INTEL.)
|
||||
C 1. Fold the special case of
|
||||
C symbol(const).member(const) where
|
||||
C element_size(symbol).ne.0
|
||||
C (modulo element_size(member)).
|
||||
C 2. Increase max number of globals to 800.
|
||||
C 3. Fix bug in EXTRACT_DISPLACEMENT
|
||||
C (downward/upward coercions are not
|
||||
C transitive).
|
||||
C 4. Change names of all out-of-line builtins
|
||||
C to the unified versions.
|
||||
C (Modules affected: PLM,PLMCOM,FOLD,INIT.)
|
||||
C
|
||||
C VERSION 5.0 AFH 19AUG81 1. Support COMPACT and MEDIUM models as
|
||||
C well as SMALL and LARGE.
|
||||
C 2. Implement VECTOR control in place of
|
||||
C ACALLS control.
|
||||
C (Modules affected: PLM,PLMCOM,SOMEWHERE,
|
||||
C CONTROL,OPERAND,SUMMARY,UNIQUE,PROCS,
|
||||
C BASICS,REGS,MODULES,EXPRS,INIT,EMIT,UNITS.)
|
||||
C
|
||||
C VERSION 5.1 AFH 08SEP81 1. Compute reference counts (resolves
|
||||
C semantic ambiguity of multiple assign-
|
||||
C ment statements in favor of PL/M-86
|
||||
C interpretation.
|
||||
C (Modules affected: PLM,SOMEWHERE,BASICS,
|
||||
C MASSAGE,COUNTS.)
|
||||
C
|
||||
C VERSION 5.2 AFH 13SEP81 1. Implement the ALIGN control.
|
||||
C (Modules affected: PLM,MODULES,DECLS.)
|
||||
C
|
||||
C VERSION 5.3 AFH 29SEP81 1. Fix CRC-0 bug on reference to STACK$PTR.
|
||||
C 2. Correct choice of SP for STACK$PTR.
|
||||
C 3. Increase symbol table to 2000 entries.
|
||||
C 4. Allow DATA attribute with EXTERNAL.
|
||||
C 5. Allow dimensions >64K.
|
||||
C 6. Allow structure member arrays to have
|
||||
C explicit lower bounds.
|
||||
C 7. Implement the builtin function FIRST.
|
||||
C 8. Support the AT(@external.member)
|
||||
C construct.
|
||||
C 9. Increase max string size to 290 chars
|
||||
C (for larger LITERALLY's).
|
||||
C (Modules changed: PLMCOM,PLM,COUNTS,
|
||||
C BUILTINS,SYMTAB,DATA,DECLS,EMIT,REPLICA,
|
||||
C INIT,GETLEX. All modules were recompiled
|
||||
C because of changes to PLMCOM.)
|
||||
C
|
||||
C VERSION 5.4 AFH 15OCT81 1. Experimental version to try out
|
||||
C reference count stuff.
|
||||
C (Modules changed: PLM,COUNTS,SOMEWHERE,
|
||||
C REGS.)
|
||||
C
|
||||
C VERSION 5.5 AFH 21OCT81 1. Add basic block analysis.
|
||||
C 2. Implement %_signed and %_unsigned
|
||||
C builtins.
|
||||
C
|
||||
C VERSION 5.6 AFH 23OCT81 1. More peephole optimizations.
|
||||
C 2. Add OP_BB operator.
|
||||
C 3. No reference counts for OP_LOC
|
||||
C and OP_ASSN.
|
||||
C
|
||||
C VERSION 5.7 AFH 28OCT81 1. Add definitions for SELECTOR, DWORD,
|
||||
C SHORT, and BOOLEAN data types.
|
||||
C 2. Allow keywords to be re-declared.
|
||||
C
|
||||
C VERSION 5.8 AFH 06NOV81 1. Add ASSUME control.
|
||||
C
|
||||
C VERSION 5.9 AFH 09NOV81 1. Implement CSE,CTE,BBA,MCO assumptions.
|
||||
C
|
||||
C VERSION 6.0 AFH 10NOV81 1. Add EFFECTS module.
|
||||
C 2. Add DBG assumption.
|
||||
C 3. Fix DRC bug in SCOPES.
|
||||
C 4. Implement EEQ,BRO,SWB assumptions.
|
||||
C
|
||||
C VERSION 6.1 AFH 12NOV81 1. Restore argument pointer display in
|
||||
C transfer vector prologue.
|
||||
C 2. Change psect names, and add the
|
||||
C symbol_psect field to the symbol
|
||||
C table.
|
||||
C 3. Make ATOM_DISP be I*4. (All modules
|
||||
C must be recompiled.)
|
||||
C 4. Implement LAST(MEMORY), etc.
|
||||
C 5. Allow structure arrays to be implicitly
|
||||
C dimensioned.
|
||||
C 6. Implement AT(arg) and AT(dynamic).
|
||||
C
|
||||
C VERSION 6.2 AFH 14NOV81 1. Change addressing modes to reflect
|
||||
C new psect usage.
|
||||
C
|
||||
C VERSION 6.3 AFH 21NOV81 1. Temporarily change LOW back to an
|
||||
C external to correct a bug with
|
||||
C extract_displacement.
|
||||
C
|
||||
C VERSION 6.4 AFH 10JAN82 1. Change DOUBLE keyword to DOUBLE$-
|
||||
C PRECISION to avoid conflict with
|
||||
C the DOUBLE builtin.
|
||||
C 2. Set VMS delimiter set in CONTROL.
|
||||
C
|
||||
C VERSION 6.5 AFH 14JAN82 1. Change ASSUME_S32 to ASSUME_S64.
|
||||
C 2. Ignore $-signs in switch names.
|
||||
C 3. Make <keyword>: and GOTO <keyword>
|
||||
C work correctly.
|
||||
C
|
||||
C VERSION 6.6 AFH 03FEB82 1. Fix bug for immediate operands
|
||||
C under LARGE model (OPERAND).
|
||||
C 2. Change name of GET_CNTRL_FLD.
|
||||
C
|
||||
C VERSION 6.7 AFH 08FEB82 1. Merge ARG opnodes.
|
||||
C 2. Change opcode column in emitted code
|
||||
C to allow longer emitted code lines.
|
||||
C
|
||||
C***********************************************************************
|
||||
|
||||
PROGRAM PLM
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*45 FILE1_CHARS,FILE2_CHARS,FILE3_CHARS
|
||||
|
||||
VERSION=6.7
|
||||
IN=8
|
||||
OUT=4
|
||||
LST=6
|
||||
IXI=3
|
||||
FIFO_DEPTH=0
|
||||
LIST_LINE_NO=0
|
||||
LIST_STNO=1
|
||||
LIST_BLOCK_LEVEL=0
|
||||
LINE_OF_PAGE=1
|
||||
PAGE_NO=0
|
||||
LINES_READ=0
|
||||
ERRORS=0
|
||||
WARNINGS=0
|
||||
PREVIOUS_STNO=0
|
||||
EXTERNAL_SERIAL_DELTA=0
|
||||
BASED_SERIAL_DELTA=0
|
||||
SUBSCRIPTED_SERIAL_DELTA=0
|
||||
OVERLAID_SERIAL_DELTA=0
|
||||
PATH=.FALSE.
|
||||
BASIC_BLOCK=NULL
|
||||
CALL BREAK
|
||||
|
||||
C------- SET DEFAULT VALUES OF PRIMARY CONTROLS.
|
||||
|
||||
LARGE=.FALSE.
|
||||
PAGELENGTH=LIB$LP_LINES()-5
|
||||
PAGEWIDTH=120
|
||||
OPTIMIZE=1
|
||||
MODEL=1
|
||||
PRINT_FLAG=.TRUE.
|
||||
XREF_FLAG=.FALSE.
|
||||
IXREF_FLAG=.FALSE.
|
||||
SYMBOLS_FLAG=.FALSE.
|
||||
PAGING_FLAG=.TRUE.
|
||||
INTVECTOR_FLAG=.TRUE.
|
||||
OBJECT_FLAG=.TRUE.
|
||||
OPRINT_FLAG=.FALSE.
|
||||
DEBUG_FLAG=.FALSE.
|
||||
TYPE_FLAG=.TRUE.
|
||||
ROM_FLAG=.FALSE.
|
||||
TITLE_STRING(0)=0
|
||||
TABS=8
|
||||
WARN_FLAG=.TRUE.
|
||||
PLM80_FLAG=.FALSE.
|
||||
GLOBALS_FLAG=.FALSE.
|
||||
PUBLICS_FLAG=.FALSE.
|
||||
OVERLAY_FLAG=.FALSE.
|
||||
ROOT_FLAG=.FALSE.
|
||||
ALIGN_FLAG=.FALSE.
|
||||
FREQ_FLAG=.FALSE.
|
||||
VECTOR_FLAG=.FALSE.
|
||||
|
||||
CALL DATE(DATE_STRING(1))
|
||||
DATE_STRING(10)=' '
|
||||
CALL TIME(DATE_STRING(11))
|
||||
DATE_STRING(0)=18
|
||||
|
||||
C------- SET DEFAULT VALUES OF GENERAL CONTROLS.
|
||||
|
||||
LEFTMARGIN=1
|
||||
RIGHTMARGIN=200
|
||||
LIST_FLAG=.TRUE.
|
||||
NON_CONTROL_LINE_READ=.FALSE.
|
||||
SKIP_STATE=0 ! READING INVOCATION LINE.
|
||||
CODE_FLAG=.FALSE.
|
||||
EJECT_FLAG=.TRUE.
|
||||
OVERFLOW_FLAG=.FALSE.
|
||||
COND_FLAG=.TRUE.
|
||||
SUBTITLE_STRING(0)=0
|
||||
|
||||
C-------- SET DEFAULT VALUES OF ASSUMPTION FLAGS.
|
||||
|
||||
ASSUME_SCE=.TRUE.
|
||||
ASSUME_CSE=.TRUE.
|
||||
ASSUME_EEQ=.TRUE.
|
||||
ASSUME_PSE=.TRUE.
|
||||
ASSUME_BRO=.TRUE.
|
||||
ASSUME_BBA=.TRUE.
|
||||
ASSUME_CTE=.TRUE.
|
||||
ASSUME_MCO=.TRUE.
|
||||
ASSUME_CFA=.TRUE.
|
||||
ASSUME_SWB=.TRUE.
|
||||
ASSUME_OSR=.TRUE.
|
||||
ASSUME_SVE=.TRUE.
|
||||
ASSUME_S64=.TRUE.
|
||||
ASSUME_C7F=.TRUE.
|
||||
ASSUME_DBG=.FALSE.
|
||||
|
||||
C-------- PERFORM A COMPILATION.
|
||||
|
||||
CALL INVOCATION_LINE
|
||||
SKIP_STATE=4 ! READING AT LEVEL 0.
|
||||
CALL GETC
|
||||
CALL GETLEX
|
||||
CALL GETTOK
|
||||
CALL COMPILATION
|
||||
|
||||
C-------- CHAIN TO MACRO IF OBJECT WANTED.
|
||||
|
||||
IF (OBJECT_FLAG) THEN
|
||||
IF (OPRINT_FLAG) THEN
|
||||
CALL LIB$DO_COMMAND(
|
||||
# 'MAC/OBJ=' //
|
||||
# FILE1_CHARS(:MAKE_CHARS(FILE1_CHARS,OBJECT_FILE_STRING))
|
||||
# // '/LIS=' //
|
||||
# FILE2_CHARS(:MAKE_CHARS(FILE2_CHARS,OPRINT_FILE_STRING))
|
||||
# // ' ' //
|
||||
# FILE3_CHARS(:MAKE_CHARS(FILE3_CHARS,WORK_FILE_STRING)))
|
||||
ELSE
|
||||
CALL LIB$DO_COMMAND(
|
||||
# 'MAC/OBJ=' //
|
||||
# FILE1_CHARS(:MAKE_CHARS(FILE1_CHARS,OBJECT_FILE_STRING))
|
||||
# // '/NOLIS ' //
|
||||
# FILE3_CHARS(:MAKE_CHARS(FILE3_CHARS,WORK_FILE_STRING)))
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
END
|
||||
13
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/plm.lnk
Normal file
13
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/plm.lnk
Normal file
@@ -0,0 +1,13 @@
|
||||
$SET VERIFY
|
||||
$!
|
||||
$! PLM.LNK
|
||||
$!
|
||||
$! Command file to link the PL/M-VAX compiler.
|
||||
$!
|
||||
$! 02FEB82 Alex Hunter 1. Original version.
|
||||
$! 04FEB82 Alex Hunter 1. Use LOGNAMES.COM to set logical names.
|
||||
$!
|
||||
$@LOGNAMES
|
||||
$LINK/NODEB/EXE=PLM/NOMAP -
|
||||
PLMCOM/INCLUDE=PLM/LIB,-
|
||||
PLM$UDI:PLMRUN/LIB
|
||||
539
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/plmcom.for
Normal file
539
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/plmcom.for
Normal file
@@ -0,0 +1,539 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C PLMCOM.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This include-file supplies all global definitions for the
|
||||
C PL/M-VAX compiler.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 29SEP81 Alex Hunter 1. Increase SYMBOL_MAX. (V5.3)
|
||||
C 2. Increase max string size to 290.
|
||||
C 3. Change relevant SYMBOL and MEMBER arrays
|
||||
C to INTEGER*4.
|
||||
C 4. Add MEMBER_LOWER_BOUND array to support
|
||||
C lower bounds for structure member arrays.
|
||||
C 5. Add MEMBER_OFFSET array to support the
|
||||
C AT(@external.member) construct.
|
||||
C 21OCT81 Alex Hunter 1. Add stuff for basic block analysis. (V5.5)
|
||||
C 2. Add OP_SIGNED and OP_UNSIGNED operators.
|
||||
C 28OCT81 Alex Hunter 1. Add new keywords (SELECTOR-REGISTER). (V5.7)
|
||||
C 2. Add new symbol type attributes.
|
||||
C 09NOV81 Alex Hunter 1. Add assumption flags. (V5.8)
|
||||
C 10NOV81 Alex Hunter 1. Add S_NO_SIDE_EFFECTS, ASSUME_DBG, and
|
||||
C serial no. deltas. (V6.0)
|
||||
C 12NOV81 Alex Hunter 1. Add S_REGISTER,S_SPECIAL,SYMBOL_PSECT,
|
||||
C SYM_MLAST, et al. (V6.1)
|
||||
C 2. Change ATOM_DISP to I*4.
|
||||
C 3. Delete predefined atoms.
|
||||
C 4. Add new PSECTS and change names.
|
||||
C 14JAN82 Alex Hunter 1. Change ASSUME_S32 to ASSUME_S64. (V6.5)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
IMPLICIT INTEGER*2 (A-Z)
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Reserved word token values.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
PARAMETER K_ADDRESS=101, K_AND=102, K_AT=103, K_BASED=104,
|
||||
# K_BY=105, K_BYTE=106, K_CALL=107, K_CASE=108,
|
||||
# K_DATA=109, K_DECLARE=110, K_DISABLE=111, K_DO=112,
|
||||
# K_ELSE=113, K_ENABLE=114, K_END=115, K_EOF=116,
|
||||
# K_EXTERNAL=117, K_GO=118, K_GOTO=119, K_HALT=120,
|
||||
# K_IF=121, K_INITIAL=122, K_INTEGER=123,
|
||||
# K_INTERRUPT=124, K_LABEL=125, K_LITERALLY=126,
|
||||
# K_MINUS=127, K_MOD=128, K_NOT=129, K_OR=130,
|
||||
# K_PLUS=131, K_POINTER=132, K_PROCEDURE=133,
|
||||
# K_PUBLIC=134, K_REAL=135, K_REENTRANT=136,
|
||||
# K_RETURN=137, K_STRUCTURE=138, K_THEN=139, K_TO=140,
|
||||
# K_WHILE=141, K_WORD=142, K_XOR=143,
|
||||
# K_COMMON=144, K_LONG=145, K_DOUBLE=146, K_OTHERWISE=147,
|
||||
# K_QUAD=148,K_FORWARD=149,K_SELECTOR=150,K_DWORD=151,
|
||||
# K_SHORT=152,K_BOOLEAN=153,K_REGISTER=154
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Delimiter token values.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
PARAMETER D_PLUS=201, D_MINUS=202, D_STAR=203, D_SLASH=204,
|
||||
# D_LT=205, D_GT=206, D_EQ=207, D_NE=208, D_LE=209,
|
||||
# D_GE=210, D_ASSN=211, D_COLON=212, D_SEMI=213,
|
||||
# D_DOT=214, D_COMMA=215, D_LP=216, D_RP=217, D_AT=218
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Non-terminal token values.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
PARAMETER NT_STATEMENT=301,NT_EXPRESSION=302,NT_TYPE=303
|
||||
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Controls.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*2 LEFTMARGIN,RIGHTMARGIN,SKIP_STATE,PAGELENGTH,
|
||||
# PAGEWIDTH,OPTIMIZE,MODEL,TABS
|
||||
LOGICAL*1 LIST_FLAG,LARGE,NON_CONTROL_LINE_READ
|
||||
LOGICAL*1 PRINT_FLAG,CODE_FLAG,XREF_FLAG,IXREF_FLAG,SYMBOLS_FLAG,
|
||||
# PAGING_FLAG,EJECT_FLAG,INTVECTOR_FLAG,OBJECT_FLAG,
|
||||
# OVERFLOW_FLAG,DEBUG_FLAG,TYPE_FLAG,ROM_FLAG,COND_FLAG,
|
||||
# OPRINT_FLAG,WARN_FLAG,PLM80_FLAG,GLOBALS_FLAG,
|
||||
# PUBLICS_FLAG,OVERLAY_FLAG,ROOT_FLAG,ALIGN_FLAG,
|
||||
# FREQ_FLAG,VECTOR_FLAG
|
||||
PARAMETER MAX_IN=20
|
||||
BYTE PRINT_FILE_STRING(0:45),IXREF_FILE_STRING(0:45),
|
||||
# WORK_FILE_STRING(0:45),OBJECT_FILE_STRING(0:45),
|
||||
# DATE_STRING(0:80),TITLE_STRING(0:80),SUBTITLE_STRING(0:80),
|
||||
# IN_FILE_STRING(0:45,8:MAX_IN+1),OPRINT_FILE_STRING(0:45),
|
||||
# GLOBALS_FILE_STRING(0:45),PUBLICS_FILE_STRING(0:45),
|
||||
# OVERLAY_PREFIX(0:80)
|
||||
COMMON/CONTROLS/ LEFTMARGIN,RIGHTMARGIN,LIST_FLAG,LARGE,
|
||||
# NON_CONTROL_LINE_READ,SKIP_STATE,PAGELENGTH,PAGEWIDTH,
|
||||
# OPTIMIZE,MODEL,PRINT_FLAG,CODE_FLAG,XREF_FLAG,IXREF_FLAG,
|
||||
# SYMBOLS_FLAG,PAGING_FLAG,EJECT_FLAG,INTVECTOR_FLAG,
|
||||
# OBJECT_FLAG,OVERFLOW_FLAG,DEBUG_FLAG,TYPE_FLAG,ROM_FLAG,
|
||||
# COND_FLAG,
|
||||
# PRINT_FILE_STRING,IXREF_FILE_STRING,WORK_FILE_STRING,
|
||||
# OBJECT_FILE_STRING,DATE_STRING,TITLE_STRING,
|
||||
# SUBTITLE_STRING,IN_FILE_STRING,OPRINT_FILE_STRING,
|
||||
# OPRINT_FLAG,TABS,WARN_FLAG,PLM80_FLAG,GLOBALS_FLAG,
|
||||
# PUBLICS_FLAG,OVERLAY_FLAG,ROOT_FLAG,GLOBALS_FILE_STRING,
|
||||
# PUBLICS_FILE_STRING,OVERLAY_PREFIX,ALIGN_FLAG,FREQ_FLAG,
|
||||
# VECTOR_FLAG
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Character stream input and macro expansion stuff.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
PARAMETER LITMAX=16
|
||||
PARAMETER EOLCHAR='01'X, EOFCHAR='02'X
|
||||
INTEGER*2 COL, LITLEV, LITCOL(LITMAX)
|
||||
CHARACTER*1 CHAR, EOL, EOF, TAB
|
||||
CHARACTER*300 LITVAL(LITMAX), CARD
|
||||
EQUIVALENCE (CARD,LITVAL(1))
|
||||
COMMON /LEXICAL/ COL,LITLEV,LITCOL
|
||||
COMMON /LEXCHAR/ LITVAL,CHAR,EOL,EOF,TAB
|
||||
DATA COL/72/, CARD(73:73)/EOLCHAR/, LITLEV/1/
|
||||
DATA EOL/EOLCHAR/, EOF/EOFCHAR/, TAB/'09'X/
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Lexical token analysis stuff.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
PARAMETER STRING_SIZE_MAX=290 ! (V5.3)
|
||||
CHARACTER DELIMITER*2, IDENTIFIER*32, STRING*(STRING_SIZE_MAX)
|
||||
CHARACTER NEXT_DELIMITER*2, NEXT_IDENTIFIER*32,
|
||||
# NEXT_STRING*(STRING_SIZE_MAX)
|
||||
REAL*8 FLOATVAL, NEXT_FLOATVAL
|
||||
INTEGER*4 FIXVAL, NEXT_FIXVAL
|
||||
INTEGER*2 TOKENTYPE, TT, STRLEN
|
||||
INTEGER*2 NEXT_TOKENTYPE, NEXT_STRLEN
|
||||
PARAMETER INVALID=0, DELIM=1, ID=2, FIXCON=3, FLOATCON=4,
|
||||
# STRCON=5, EOFTOK=6
|
||||
COMMON /TOKEN/ TOKENTYPE,FIXVAL,FLOATVAL,STRLEN,
|
||||
# NEXT_TOKENTYPE,NEXT_FIXVAL,NEXT_FLOATVAL,
|
||||
# NEXT_STRLEN
|
||||
COMMON /TOKENCHAR/ DELIMITER,IDENTIFIER,STRING,
|
||||
# NEXT_DELIMITER,NEXT_IDENTIFIER,NEXT_STRING
|
||||
EQUIVALENCE (TT,TOKENTYPE)
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C I/O unit definitions.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
COMMON /IO/ IN,OUT,LST,IXI,GBL,PUB
|
||||
DATA IN/8/, OUT/4/, LST/6/, IXI/3/, GBL/1/, PUB/2/
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Label structures.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
PARAMETER MAX_LABELS=10
|
||||
CHARACTER*32 LABELS(MAX_LABELS), LAST_LABEL
|
||||
INTEGER*2 NLABELS
|
||||
COMMON /LABEL/ NLABELS
|
||||
COMMON /LABELC/ LABELS, LAST_LABEL
|
||||
DATA NLABELS /0/
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Symbol attribute values.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
PARAMETER S_MACRO=1,S_SCALAR=2,S_ARRAY=3,S_PROC=4,S_LABEL=5,
|
||||
# S_KEYWORD=6
|
||||
|
||||
PARAMETER S_BYTE=1,S_WORD=2,S_INTEGER=3,S_PTR=4,S_REAL=5,
|
||||
# S_LONG=6,S_DOUBLE=7,S_QUAD=8,S_SHORT=9,S_DWORD=10,
|
||||
# S_SELECTOR=11,S_BOOLEAN=12,
|
||||
# S_STRUC=100
|
||||
|
||||
PARAMETER S_EXT=1,S_STATIC=2,S_BASED=3,S_ARG=4,S_FORWARD=5,
|
||||
# S_DYNAMIC=6, S_VALUE=8,S_UNRESOLVED=9,
|
||||
# S_BUILTIN=10,S_LOCAL=11,S_REGISTER=12
|
||||
|
||||
PARAMETER S_PUBLIC=1,S_UNDEF=2,S_INTERRUPT=4,S_REENT=8,
|
||||
# S_FORCE_STATIC=16,S_DATA=32,S_OVERLAID=64,
|
||||
# S_SAME_OVERLAY=128,S_NOTPUBLIC=256,
|
||||
# S_NO_SIDE_EFFECTS=512,S_SPECIAL=1024
|
||||
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Symbol table structures.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
PARAMETER SYMBOL_MAX=2000, MEMBER_MAX=500, PARAM_MAX=100
|
||||
PARAMETER SYM_MLAST=1,SYM_MLEN=2,SYM_MSIZ=3,
|
||||
# SYM_SLAST=4,SYM_SLEN=5,SYM_SSIZ=6,
|
||||
# FIRST_AVAILABLE_SYMBOL_INDEX=7
|
||||
|
||||
CHARACTER*32 SYMBOL_PLM_ID(SYMBOL_MAX), SYMBOL_VAX_ID(SYMBOL_MAX)
|
||||
INTEGER*2 SYMBOL_KIND(SYMBOL_MAX), SYMBOL_TYPE(SYMBOL_MAX),
|
||||
# SYMBOL_LINK(SYMBOL_MAX), SYMBOL_LIST_SIZE(SYMBOL_MAX),
|
||||
# SYMBOL_REF(SYMBOL_MAX), SYMBOL_BASE(SYMBOL_MAX),
|
||||
# SYMBOL_BASE_MEMBER(SYMBOL_MAX),
|
||||
# SYMBOL_FLAGS(SYMBOL_MAX), SYMBOL_INDEX,
|
||||
# SYMBOL_CHAIN(SYMBOL_MAX),
|
||||
# SYMBOL_SERIAL_NO(SYMBOL_MAX),
|
||||
# SYMBOL_PSECT(SYMBOL_MAX)
|
||||
INTEGER*4 SYMBOL_DISP(SYMBOL_MAX),SYMBOL_NBR_ELEMENTS(SYMBOL_MAX),
|
||||
# SYMBOL_LOWER_BOUND(SYMBOL_MAX),
|
||||
# SYMBOL_ELEMENT_SIZE(SYMBOL_MAX)
|
||||
LOGICAL*4 SAME_OVERLAY
|
||||
COMMON/SYMBOLC/SYMBOL_PLM_ID,SYMBOL_VAX_ID
|
||||
COMMON/SYMBOL/SYMBOL_KIND,SYMBOL_TYPE,
|
||||
# SYMBOL_LINK,SYMBOL_LIST_SIZE,
|
||||
# SYMBOL_REF,SYMBOL_BASE,SYMBOL_BASE_MEMBER,
|
||||
# SYMBOL_FLAGS,SYMBOL_INDEX,SYMBOL_CHAIN,SAME_OVERLAY,
|
||||
# SYMBOL_SERIAL_NO,SYMBOL_PSECT
|
||||
COMMON/SYMBOL4/SYMBOL_DISP,SYMBOL_NBR_ELEMENTS,
|
||||
# SYMBOL_LOWER_BOUND,SYMBOL_ELEMENT_SIZE
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Member-symbol table structures.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
CHARACTER*32 MEMBER_PLM_ID(MEMBER_MAX), MEMBER_VAX_ID(MEMBER_MAX)
|
||||
INTEGER*2 MEMBER_KIND(MEMBER_MAX), MEMBER_TYPE(MEMBER_MAX),
|
||||
# MEMBER_INDEX,MEMBER_SERIAL_NO(MEMBER_MAX)
|
||||
INTEGER*4 MEMBER_NBR_ELEMENTS(MEMBER_MAX),
|
||||
# MEMBER_LOWER_BOUND(MEMBER_MAX),
|
||||
# MEMBER_ELEMENT_SIZE(MEMBER_MAX),
|
||||
# MEMBER_OFFSET(MEMBER_MAX)
|
||||
COMMON/MEMBERC/MEMBER_PLM_ID,MEMBER_VAX_ID
|
||||
COMMON/MEMBER/MEMBER_KIND,MEMBER_TYPE,MEMBER_INDEX,
|
||||
# MEMBER_SERIAL_NO
|
||||
COMMON/MEMBER4/MEMBER_NBR_ELEMENTS,MEMBER_LOWER_BOUND,
|
||||
# MEMBER_ELEMENT_SIZE,MEMBER_OFFSET
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Parameter list structures.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*2 PARAM_TYPE(PARAM_MAX)
|
||||
COMMON/PARAM/PARAM_TYPE
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Block scope structures.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
PARAMETER BLOCK_MAX=20
|
||||
INTEGER*2 BLOCK_LEVEL,SYMBOL_TOP(0:BLOCK_MAX),
|
||||
# MEMBER_TOP(0:BLOCK_MAX),PARAM_TOP(0:BLOCK_MAX),
|
||||
# STRINGS_TOP(0:BLOCK_MAX)
|
||||
COMMON/BLOCK/BLOCK_LEVEL,SYMBOL_TOP,MEMBER_TOP,PARAM_TOP,
|
||||
# STRINGS_TOP
|
||||
DATA BLOCK_LEVEL/0/
|
||||
DATA MEMBER_TOP(0)/0/,PARAM_TOP(0)/0/,
|
||||
# STRINGS_TOP(0)/0/
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C String space structures.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
PARAMETER STRINGS_MAX=32000
|
||||
CHARACTER*(STRINGS_MAX) STRINGS
|
||||
COMMON/STRINGS/STRINGS
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Miscellaneous stuff.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*2 BYTE_SIZE(S_BYTE:S_QUAD)
|
||||
COMMON/TABLES/BYTE_SIZE
|
||||
DATA BYTE_SIZE/1,2,2,4,4,4,8,8/
|
||||
|
||||
PARAMETER NULL=0, DUMMY=0
|
||||
|
||||
PARAMETER R0=16
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Node space definitions.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
PARAMETER NODE_MIN=20,NODE_MAX=200,
|
||||
# REG_MIN=1,REG_MAX=16,
|
||||
# ANY_WHERE=-3,ANY_REG=-1,ON_STACK=-2,
|
||||
# CON_MIN=-9,CON_MAX=-4,
|
||||
# ATOM_MIN=-200,ATOM_MAX=-10,
|
||||
# FIRST_FREE_ATOM=ATOM_MIN,
|
||||
# FIX_MIN=-300,FIX_MAX=-201,
|
||||
# FLT_MIN=-400,FLT_MAX=-301
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Operator node structures.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*2 OPNODE_OP(NODE_MIN:NODE_MAX),
|
||||
# OPNODE_OPND1(NODE_MIN:NODE_MAX),
|
||||
# OPNODE_OPND2(NODE_MIN:NODE_MAX),
|
||||
# NEXT_NODE
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Atom node structures.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*2 ATOM_SYM(ATOM_MIN:ATOM_MAX),
|
||||
# ATOM_MEM(ATOM_MIN:ATOM_MAX),
|
||||
# ATOM_BASE(ATOM_MIN:ATOM_MAX),
|
||||
# ATOM_SUB(ATOM_MIN:ATOM_MAX),
|
||||
# ATOM_FLAGS(ATOM_MIN:ATOM_MAX),
|
||||
# ATOM_SERIAL_NO(ATOM_MIN:ATOM_MAX),
|
||||
# NEXT_ATOM
|
||||
INTEGER*4 ATOM_DISP(ATOM_MIN:ATOM_MAX)
|
||||
|
||||
PARAMETER A_L2P=1,A_P2L=2,A_IMMEDIATE=4,A_CTIM=8,A_VECTOR=16
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Literal and constant node structures.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*4 FIXED_VAL(FIX_MIN:FIX_MAX),
|
||||
# NEXT_FIXED
|
||||
|
||||
REAL*8 FLOAT_VAL(FLT_MIN:FLT_MAX)
|
||||
INTEGER*2 NEXT_FLOAT
|
||||
|
||||
INTEGER*2 CONSTANT_LABEL(CON_MIN:CON_MAX),
|
||||
# NEXT_CONSTANT
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Structures common to all nodes.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*2 NODE_REG(FLT_MIN:NODE_MAX),
|
||||
# NODE_REFCT(FLT_MIN:NODE_MAX),
|
||||
# NODE_TYPE(FLT_MIN:NODE_MAX),
|
||||
# NODE_CONTEXT(FLT_MIN:NODE_MAX)
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Code tree common block.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
COMMON/TREE/OPNODE_OP,OPNODE_OPND1,OPNODE_OPND2,
|
||||
# ATOM_SYM,ATOM_MEM,ATOM_BASE,
|
||||
# ATOM_SUB,ATOM_DISP,
|
||||
# FIXED_VAL,FLOAT_VAL,
|
||||
# NODE_REG,NODE_REFCT,NODE_CONTEXT,NODE_TYPE,
|
||||
# NEXT_NODE,NEXT_ATOM,NEXT_FIXED,NEXT_FLOAT,
|
||||
# CONSTANT_LABEL,NEXT_CONSTANT,ATOM_FLAGS,
|
||||
# ATOM_SERIAL_NO
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Context resolution stuff.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
PARAMETER CX_UNSIGNED=1, CX_SIGNED=2
|
||||
|
||||
INTEGER*2 CONTEXT(S_BYTE:S_QUAD)
|
||||
COMMON /CX/ CONTEXT
|
||||
DATA CONTEXT
|
||||
# /CX_UNSIGNED,CX_UNSIGNED,CX_SIGNED,CX_UNSIGNED,CX_SIGNED,
|
||||
# CX_SIGNED,CX_SIGNED,CX_SIGNED/
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Miscellaneous declarations.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
LOGICAL*4 ATOM,NODE,LITERAL,FIXLIT,FLOATLIT,CONSTANT,REGISTER
|
||||
CHARACTER*32 LOCAL_LABEL
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Operator value definitions.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
PARAMETER OP_NOP=0,
|
||||
# OP_ADD=1,OP_SUB=2,OP_MUL=3,OP_DIV=4,OP_ADWC=5,OP_SBWC=6,
|
||||
# OP_NEG=7,OP_NOT=8,OP_EXT=9,OP_OR=10,OP_XOR=11,OP_LT=12,
|
||||
# OP_GT=13,OP_EQ=14,OP_NE=15,OP_LE=16,OP_GE=17,OP_LOC=18,
|
||||
# OP_ASSN=19,OP_MOD=20,OP_THEN=21,OP_BIT=22,OP_ALSO=23,
|
||||
# OP_CALL=24,OP_ARG=25,OP_AND=26,OP_MOV=27,
|
||||
# OP_SIGNED=71,OP_UNSIGNED=72,
|
||||
# OP_BYTE=81,OP_WORD=82,OP_INTEGER=83,OP_PTR=84,
|
||||
# OP_REAL=85,OP_LONG=86,OP_DOUBLE=87,OP_QUAD=88,
|
||||
# OP_B2W=101,OP_B2I=102,OP_B2L=103,OP_B2R=104,OP_W2B=105,
|
||||
# OP_W2L=106,OP_I2B=107,OP_I2R=108,OP_I2L=109,OP_R2L=110,
|
||||
# OP_R2I=111,OP_L2W=112,OP_L2R=113,OP_L2B=114,OP_R2B=115,
|
||||
# OP_R2W=116,OP_L2D=117,OP_L2Q=118,OP_R2D=119,OP_D2B=120,
|
||||
# OP_D2I=121,OP_D2R=122,OP_D2L=123,OP_Q2L=124,OP_I2D=125,
|
||||
# OP_L2P=126,OP_P2L=127,
|
||||
# OP_BNE=201,OP_BLB=202,OP_BB=203
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Program section definitions.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
PARAMETER P_MAX=100
|
||||
PARAMETER P_CONSTANTS=1,P_STACK=2,P_DATA=3,P_CODE=4,P_FREQ=5,
|
||||
# P_VECTOR=6,P_APD=7,P_MEMORY=8
|
||||
CHARACTER*32 PSECT_NAME(P_CONSTANTS:P_MAX),BASEC
|
||||
CHARACTER*3 BASEV
|
||||
COMMON /PSECTC/ BASEC,BASEV,PSECT_NAME
|
||||
DATA PSECT_NAME
|
||||
// '$PLM_ROM','$DGROUP_STACK','$DGROUP_DATA'
|
||||
,, '$PLM_CODE','$PLM_FREQ','$CGROUP_VECTOR'
|
||||
,, '$PLM_APD','MEMORY'
|
||||
,, 92*' '
|
||||
//
|
||||
|
||||
INTEGER*2 NC
|
||||
COMMON /PSECTS/ NC
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Compiler listing stuff.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
REAL*4 VERSION
|
||||
LOGICAL*1 LISTING_TO_TERMINAL,LAST_LINE_EXISTS
|
||||
COMMON /LIST/ LIST_LINE_NO,LIST_STNO,LIST_BLOCK_LEVEL,
|
||||
# PREVIOUS_STNO,LINE_OF_PAGE,PAGE_NO,VERSION,
|
||||
# LINES_READ,ERRORS,WARNINGS,LISTING_TO_TERMINAL,
|
||||
# FIFO_DEPTH,LAST_LINE_EXISTS
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Symbol table hash buckets.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*2 HASH_BUCKET(0:210)
|
||||
COMMON /HASH/ HASH_BUCKET,FIRST_KEYWORD
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Procedure scope structures.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
PARAMETER PROC_MAX=16 ! MAX STATIC NESTING DEPTH OF PROCS.
|
||||
PARAMETER PROC_MAIN=1,PROC_EXT=2,PROC_FORWARD=4,PROC_REENT=8
|
||||
|
||||
INTEGER*2 PROC_FLAGS(PROC_MAX),PROC_DYN_OFF(PROC_MAX),
|
||||
# PROC_INDEX(PROC_MAX),PROC_DYN_INDEX(PROC_MAX),
|
||||
# PROC_ENTRY_MASK(PROC_MAX),PROC_ENTRY_INDEX(PROC_MAX),
|
||||
# PROC_AP(0:PROC_MAX)
|
||||
COMMON /PROCS/ PROC_LEVEL,PROC_FLAGS,PROC_DYN_OFF,PROC_INDEX,
|
||||
# PROC_DYN_INDEX,PROC_ENTRY_MASK,PROC_ENTRY_INDEX,
|
||||
# PROC_AP
|
||||
DATA PROC_LEVEL/1/, PROC_FLAGS(1)/PROC_MAIN/,
|
||||
# PROC_AP(0)/1/, PROC_AP(1)/1/
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Path analysis stuff.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
LOGICAL*4 PATH
|
||||
COMMON /PATH_ANALYSIS/ PATH
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C GLOBALS symbol table stuff.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
PARAMETER GBL_MAX=800 ! MAX # OF GLOBALLY INPUT SYMBOLS.
|
||||
CHARACTER*32 GLOBAL_SYMBOL(GBL_MAX)
|
||||
INTEGER*2 LAST_GLOBAL
|
||||
COMMON /GLOBALS/ LAST_GLOBAL
|
||||
COMMON /GLOBALC/ GLOBAL_SYMBOL
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Basic block analysis stuff.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
LOGICAL*4 END_OF_BASIC_BLOCK
|
||||
INTEGER*2 BASIC_BLOCK
|
||||
INTEGER*2 EXTERNAL_SERIAL_DELTA,BASED_SERIAL_DELTA,
|
||||
# SUBSCRIPTED_SERIAL_DELTA,OVERLAID_SERIAL_DELTA
|
||||
COMMON /BASIC_BLOCKS/ END_OF_BASIC_BLOCK,BASIC_BLOCK,
|
||||
# EXTERNAL_SERIAL_DELTA,BASED_SERIAL_DELTA,
|
||||
# SUBSCRIPTED_SERIAL_DELTA,OVERLAID_SERIAL_DELTA
|
||||
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Assumption flags.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
LOGICAL*1 ASSUME_SCE,ASSUME_CSE,ASSUME_EEQ,ASSUME_PSE,
|
||||
# ASSUME_BRO,ASSUME_BBA,ASSUME_CTE,ASSUME_MCO,
|
||||
# ASSUME_CFA,ASSUME_SWB,ASSUME_OSR,ASSUME_SVE,
|
||||
# ASSUME_S64,ASSUME_C7F,ASSUME_DBG
|
||||
|
||||
COMMON /ASSUMPTIONS/
|
||||
# ASSUME_SCE,ASSUME_CSE,ASSUME_EEQ,ASSUME_PSE,
|
||||
# ASSUME_BRO,ASSUME_BBA,ASSUME_CTE,ASSUME_MCO,
|
||||
# ASSUME_CFA,ASSUME_SWB,ASSUME_OSR,ASSUME_SVE,
|
||||
# ASSUME_S64,ASSUME_C7F,ASSUME_DBG
|
||||
|
||||
378
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/procs.for
Normal file
378
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/procs.for
Normal file
@@ -0,0 +1,378 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C PROCS.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler processes procedure
|
||||
C declarations.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 20OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 21OCT81 Alex Hunter 1. Basic block analysis. (V5.5)
|
||||
C 12NOV81 Alex Hunter 1. Save and restore argument pointer displays
|
||||
C for indirect procedure calls. (V6.1)
|
||||
C 14NOV81 Alex Hunter 1. Change addressing modes and psect usage.
|
||||
C (V6.2)
|
||||
C 2. Use full 31-character external names.
|
||||
C 3. Increase max nesting of procs with args.
|
||||
C 4. Allow keyword as formal parameter.
|
||||
C 14JAN82 Alex Hunter 1. Fix minor bug from V6.2. (V6.5)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE PROCEDURE_DEFINITION
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*32 PROC_NAME,FREQ_NAME,VECNIQUE,VEC_NAME,APD_NAME
|
||||
CHARACTER*40 REGISTER_MASK
|
||||
CHARACTER*41 APD_MASK
|
||||
CHARACTER*80 OPERAND,OPERAND1
|
||||
LOGICAL*4 PROC_IS_PUBLIC
|
||||
|
||||
PROC_LEVEL=PROC_LEVEL+1
|
||||
IF (PROC_LEVEL.GT.PROC_MAX)
|
||||
# CALL FATAL('PROCEDURES NESTED TOO DEEPLY')
|
||||
|
||||
CALL PROCEDURE_STATEMENT
|
||||
|
||||
PROC_ENTRY_MASK(PROC_LEVEL)=0
|
||||
CALL PUSHC(IDENTIFIER)
|
||||
IDENTIFIER='MSK.'//SYMBOL_PLM_ID(PROC_INDEX(PROC_LEVEL))
|
||||
CALL ENTER_SYMBOL
|
||||
PROC_ENTRY_INDEX(PROC_LEVEL)=SYMBOL_INDEX
|
||||
SYMBOL_KIND(SYMBOL_INDEX)=S_SCALAR
|
||||
SYMBOL_TYPE(SYMBOL_INDEX)=S_WORD
|
||||
SYMBOL_NBR_ELEMENTS(SYMBOL_INDEX)=1
|
||||
SYMBOL_ELEMENT_SIZE(SYMBOL_INDEX)=BYTE_SIZE(S_WORD)
|
||||
SYMBOL_REF(SYMBOL_INDEX)=S_VALUE
|
||||
CALL POPC(IDENTIFIER)
|
||||
|
||||
PROC_FLAGS(PROC_LEVEL)=0
|
||||
IF (SYMBOL_REF(PROC_INDEX(PROC_LEVEL)).EQ.S_EXT)
|
||||
# PROC_FLAGS(PROC_LEVEL)=PROC_EXT
|
||||
IF (SYMBOL_REF(PROC_INDEX(PROC_LEVEL)).EQ.S_FORWARD)
|
||||
# PROC_FLAGS(PROC_LEVEL)=PROC_FORWARD
|
||||
IF ((SYMBOL_FLAGS(PROC_INDEX(PROC_LEVEL)).AND.S_REENT).NE.0)
|
||||
# PROC_FLAGS(PROC_LEVEL)=PROC_FLAGS(PROC_LEVEL).OR.PROC_REENT
|
||||
|
||||
PROC_DYN_OFF(PROC_LEVEL)=0 ! INITIAL DYNAMIC_OFFSET.
|
||||
|
||||
CALL DECLARATIONS
|
||||
|
||||
DO 10 I=SYMBOL_TOP(BLOCK_LEVEL-1)+1,SYMBOL_TOP(BLOCK_LEVEL)
|
||||
IF (SYMBOL_REF(I).EQ.S_ARG.AND.SYMBOL_FLAGS(I).EQ.S_UNDEF)
|
||||
# THEN
|
||||
CALL ERROR('NO DECLARATION FOR FORMAL PARAMETER '//
|
||||
# SYMBOL_PLM_ID(I))
|
||||
ENDIF
|
||||
10 CONTINUE
|
||||
|
||||
IF (SYMBOL_REF(PROC_INDEX(PROC_LEVEL)).EQ.S_EXT.OR.
|
||||
# SYMBOL_REF(PROC_INDEX(PROC_LEVEL)).EQ.S_FORWARD) GO TO 20
|
||||
|
||||
CALL PSECT(P_CODE)
|
||||
CALL BREAK
|
||||
|
||||
IF (PATH) THEN
|
||||
CALL GENERATE_LOCAL_LABEL(LL)
|
||||
CALL EMIT('BRW '//LOCAL_LABEL(LL,N0))
|
||||
ELSE
|
||||
LL=0
|
||||
ENDIF
|
||||
PATH=.TRUE.
|
||||
|
||||
PROC_NAME=SYMBOL_VAX_ID(PROC_INDEX(PROC_LEVEL))
|
||||
PROC_IS_PUBLIC = (SYMBOL_FLAGS(PROC_INDEX(PROC_LEVEL)).AND.
|
||||
# S_PUBLIC).NE.0
|
||||
|
||||
IF (PROC_IS_PUBLIC) THEN
|
||||
CALL EMIT1(PROC_NAME(:LNB(PROC_NAME))//'::')
|
||||
ELSE
|
||||
CALL EMIT1(PROC_NAME(:LNB(PROC_NAME))//':')
|
||||
ENDIF
|
||||
|
||||
CALL EMIT('.WORD '//
|
||||
# SYMBOL_VAX_ID(PROC_ENTRY_INDEX(PROC_LEVEL)))
|
||||
|
||||
IF (VECTOR_FLAG) THEN
|
||||
CALL PSECT(P_VECTOR)
|
||||
VEC_NAME=VECNIQUE(PROC_NAME)
|
||||
IF (PROC_AP(PROC_LEVEL-1).LE.1) THEN
|
||||
APD_MASK=' '
|
||||
ELSE
|
||||
MASK=0
|
||||
DO I=2,PROC_LEVEL-1
|
||||
MASK=MASK .OR. ISHFT(1,I)
|
||||
ENDDO
|
||||
APD_MASK='!'//REGISTER_MASK(MASK)
|
||||
ENDIF
|
||||
N1=LNB(SYMBOL_VAX_ID(PROC_ENTRY_INDEX(PROC_LEVEL)))
|
||||
IF (PROC_IS_PUBLIC) THEN
|
||||
CALL EMIT1(VEC_NAME(:LNB(VEC_NAME))//'::')
|
||||
CALL EMIT('.WORD '//
|
||||
# SYMBOL_VAX_ID(PROC_ENTRY_INDEX(PROC_LEVEL))(:N1)
|
||||
# //APD_MASK)
|
||||
ELSE
|
||||
CALL EMIT1(VEC_NAME(:LNB(VEC_NAME))//':')
|
||||
IF (MODEL.NE.4.OR.OVERLAY_FLAG) THEN
|
||||
CALL EMIT('.WORD '//
|
||||
# SYMBOL_VAX_ID(PROC_ENTRY_INDEX(PROC_LEVEL))(:N1)
|
||||
# //APD_MASK)
|
||||
ELSE
|
||||
CALL EMIT('.WORD ^M<R11>!'//
|
||||
# SYMBOL_VAX_ID(PROC_ENTRY_INDEX(PROC_LEVEL))(:N1)
|
||||
# //APD_MASK)
|
||||
CALL EMIT('MOVAB M.,R11')
|
||||
ENDIF
|
||||
ENDIF
|
||||
DO I=2,PROC_LEVEL-1
|
||||
IF (PROC_AP(I).NE.PROC_AP(I-1)) THEN
|
||||
OPERAND1=OPERAND(PROC_AP(I),N1)
|
||||
APD_NAME=SYMBOL_VAX_ID(PROC_ENTRY_INDEX(I))
|
||||
APD_NAME(1:3)='APD'
|
||||
CALL EMIT('MOVL '//APD_NAME(:LNB(APD_NAME))//','//
|
||||
# OPERAND1(:N1))
|
||||
ENDIF
|
||||
ENDDO
|
||||
CALL GENERATE_LOCAL_LABEL(LL1)
|
||||
CALL EMIT('JMP '//LOCAL_LABEL(LL1,N0))
|
||||
CALL PSECT(P_CODE)
|
||||
CALL EMIT_LOCAL_LABEL(LL1)
|
||||
ENDIF
|
||||
|
||||
IF (PROC_IS_PUBLIC.AND.MODEL.EQ.4.AND..NOT.OVERLAY_FLAG) THEN
|
||||
CALL EMIT('MOVAB M.,R11')
|
||||
CALL PRESERVE_REG(11)
|
||||
ENDIF
|
||||
|
||||
IF (FREQ_FLAG) THEN
|
||||
FREQ_NAME='FRQ.'//PROC_NAME
|
||||
FREQ_NAME(32:)=' '
|
||||
CALL EMIT('INCL '//FREQ_NAME)
|
||||
CALL PSECT(P_FREQ)
|
||||
CALL EMIT1(FREQ_NAME(:LNB(FREQ_NAME))//'::')
|
||||
CALL EMIT('.LONG 0')
|
||||
CALL PSECT(P_CODE)
|
||||
ENDIF
|
||||
|
||||
IF (PROC_AP(PROC_LEVEL).NE.PROC_AP(PROC_LEVEL-1)) THEN
|
||||
CALL PRESERVE_REG(PROC_AP(PROC_LEVEL))
|
||||
OPERAND1=OPERAND(PROC_AP(PROC_LEVEL),N1)
|
||||
CALL EMIT('MOVL AP,'//OPERAND1(:N1))
|
||||
IF (VECTOR_FLAG) THEN
|
||||
APD_NAME=SYMBOL_VAX_ID(PROC_ENTRY_INDEX(PROC_LEVEL))
|
||||
APD_NAME(1:3)='APD'
|
||||
CALL EMIT('MOVL AP,'//APD_NAME)
|
||||
CALL PSECT(P_APD)
|
||||
CALL EMIT1(APD_NAME(:LNB(APD_NAME))//':')
|
||||
CALL EMIT('.LONG 0')
|
||||
CALL PSECT(P_CODE)
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
IF ((PROC_FLAGS(PROC_LEVEL).AND.PROC_REENT).NE.0) THEN
|
||||
CALL PUSHC(IDENTIFIER)
|
||||
IDENTIFIER='DYN.'//SYMBOL_PLM_ID(PROC_INDEX(PROC_LEVEL))
|
||||
CALL ENTER_SYMBOL
|
||||
PROC_DYN_INDEX(PROC_LEVEL)=SYMBOL_INDEX
|
||||
CALL POPC(IDENTIFIER)
|
||||
SYMBOL_KIND(PROC_DYN_INDEX(PROC_LEVEL))=S_SCALAR
|
||||
SYMBOL_TYPE(PROC_DYN_INDEX(PROC_LEVEL))=S_LONG
|
||||
SYMBOL_NBR_ELEMENTS(PROC_DYN_INDEX(PROC_LEVEL))=1
|
||||
SYMBOL_ELEMENT_SIZE(PROC_DYN_INDEX(PROC_LEVEL))=
|
||||
# BYTE_SIZE(S_LONG)
|
||||
SYMBOL_REF(PROC_DYN_INDEX(PROC_LEVEL))=S_VALUE
|
||||
DYN_SIZE=MAKE_ATOM(PROC_DYN_INDEX(PROC_LEVEL),0,NULL,NULL,
|
||||
# S_LONG,0,0)
|
||||
SF=12
|
||||
CCCC CALL PRESERVE_REG(SF) ! AP ALREADY PRESERVED BY CALL.
|
||||
IF (MODEL.EQ.2 .OR. MODEL.EQ.4) THEN
|
||||
SP=14
|
||||
ELSE
|
||||
SP=10
|
||||
CALL PRESERVE_REG(SP)
|
||||
ENDIF
|
||||
CALL EMIT_CODE(OP_SUB,DYN_SIZE,NULL,SP)
|
||||
NODE_TYPE(SP)=S_PTR
|
||||
CALL EMIT_CODE(OP_ASSN,SP,NULL,SF)
|
||||
ENDIF
|
||||
|
||||
CALL PUSH(LL,1)
|
||||
CALL UNITS
|
||||
CALL BREAK
|
||||
CALL POP(LL,1)
|
||||
|
||||
IF (PATH) THEN
|
||||
IF (SYMBOL_TYPE(PROC_INDEX(PROC_LEVEL)).NE.0) THEN
|
||||
CALL WARN('RETURN MISSING AT END OF TYPED PROCEDURE')
|
||||
CALL EMIT('CLRL R0')
|
||||
ENDIF
|
||||
CALL EMIT('RET')
|
||||
ENDIF
|
||||
PATH=.FALSE.
|
||||
CALL EMIT_LOCAL_LABEL(LL)
|
||||
|
||||
CALL EMIT1(SYMBOL_VAX_ID(PROC_ENTRY_INDEX(PROC_LEVEL))
|
||||
# (:LNB(SYMBOL_VAX_ID(PROC_ENTRY_INDEX(PROC_LEVEL))))
|
||||
# //' = '//REGISTER_MASK(PROC_ENTRY_MASK(PROC_LEVEL)))
|
||||
SYMBOL_FLAGS(PROC_ENTRY_INDEX(PROC_LEVEL))=0 ! RESET S_UNDEF.
|
||||
|
||||
IF ((PROC_FLAGS(PROC_LEVEL).AND.PROC_REENT).NE.0) THEN
|
||||
CALL EMIT_ABSDEF(SYMBOL_VAX_ID(PROC_DYN_INDEX(PROC_LEVEL)),
|
||||
# PROC_DYN_OFF(PROC_LEVEL))
|
||||
SYMBOL_FLAGS(PROC_DYN_INDEX(PROC_LEVEL))=0
|
||||
ENDIF
|
||||
|
||||
20 CALL BLOCK_END
|
||||
PROC_LEVEL=PROC_LEVEL-1
|
||||
CALL END_STATEMENT
|
||||
|
||||
RETURN
|
||||
END
|
||||
C-------------------------------------------------------
|
||||
SUBROUTINE PROCEDURE_STATEMENT
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*32 PROC_NAME,PUBLIQUE
|
||||
IF (NLABELS.EQ.0) THEN
|
||||
CALL ERROR('PROCEDURE NAME MISSING: XXX ASSUMED')
|
||||
NLABELS=1
|
||||
LABELS(NLABELS) = 'XXX'
|
||||
ENDIF
|
||||
DO 10 I=1,NLABELS-1
|
||||
CALL ERROR('EXTRANEOUS LABEL IGNORED -- '//LABELS(I))
|
||||
10 CONTINUE
|
||||
PROC_NAME=LABELS(NLABELS)
|
||||
CALL PUSHC(PROC_NAME) ! TO MATCH LABEL ON END.
|
||||
NLABELS=0
|
||||
CALL MUSTBE(K_PROCEDURE)
|
||||
IDENTIFIER=PROC_NAME
|
||||
CALL ENTER_SYMBOL
|
||||
PROC_INDEX(PROC_LEVEL)=SYMBOL_INDEX
|
||||
PROC_IX=SYMBOL_INDEX
|
||||
CALL GETTOK
|
||||
CALL BLOCK_BEGIN
|
||||
IF (TT.EQ.D_LP) THEN
|
||||
CALL FORMAL_PARAMETER_LIST(NARGS)
|
||||
ELSE
|
||||
NARGS=0
|
||||
ENDIF
|
||||
IF (TT.EQ.K_INTEGER.OR.TT.EQ.K_REAL.OR.TT.EQ.K_POINTER
|
||||
# .OR.TT.EQ.K_BYTE.OR.TT.EQ.K_WORD.OR.TT.EQ.K_ADDRESS
|
||||
# .OR.TT.EQ.K_LONG.OR.TT.EQ.K_DOUBLE.OR.TT.EQ.K_QUAD) THEN
|
||||
CALL BASIC_TYPE(PTYPE)
|
||||
ELSE
|
||||
PTYPE=0
|
||||
ENDIF
|
||||
CALL PROCEDURE_ATTRIBUTES(FLAGS,REF)
|
||||
IF (SYMBOL_REF(PROC_IX).EQ.S_FORWARD) THEN
|
||||
IF (SYMBOL_TYPE(PROC_IX).NE.PTYPE.OR.
|
||||
# SYMBOL_LIST_SIZE(PROC_IX).NE.NARGS.OR.
|
||||
# SYMBOL_FLAGS(PROC_IX).NE.FLAGS) THEN
|
||||
CALL ERROR('FORWARD DECLARATION DOESN''T MATCH THIS '//
|
||||
# 'DECLARATION OF '//SYMBOL_PLM_ID(PROC_IX))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF ((FLAGS.AND.S_PUBLIC).NE.0.OR.REF.EQ.S_EXT) THEN
|
||||
SYMBOL_VAX_ID(PROC_IX)=PUBLIQUE(SYMBOL_PLM_ID(PROC_IX))
|
||||
ENDIF
|
||||
SYMBOL_KIND(PROC_IX)=S_PROC
|
||||
SYMBOL_TYPE(PROC_IX)=PTYPE
|
||||
SYMBOL_NBR_ELEMENTS(PROC_IX)=0
|
||||
SYMBOL_ELEMENT_SIZE(PROC_IX)=0
|
||||
SYMBOL_LINK(PROC_IX)=0
|
||||
SYMBOL_LIST_SIZE(PROC_IX)=NARGS
|
||||
SYMBOL_REF(PROC_IX)=REF
|
||||
SYMBOL_BASE(PROC_IX)=0
|
||||
SYMBOL_BASE_MEMBER(PROC_IX)=0
|
||||
SYMBOL_FLAGS(PROC_IX)=FLAGS
|
||||
|
||||
IF (NARGS.EQ.0) THEN
|
||||
PROC_AP(PROC_LEVEL)=PROC_AP(PROC_LEVEL-1)
|
||||
ELSE
|
||||
PROC_AP(PROC_LEVEL)=PROC_AP(PROC_LEVEL-1)+1
|
||||
IF (PROC_AP(PROC_LEVEL).GT.9)
|
||||
# CALL FATAL('PROCEDURES WITH ARGUMENTS NESTED TOO DEEPLY')
|
||||
ENDIF
|
||||
|
||||
CALL MATCH(D_SEMI)
|
||||
RETURN
|
||||
END
|
||||
C-------------------------------------------------------
|
||||
SUBROUTINE FORMAL_PARAMETER_LIST(NARGS)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
NARGS=0
|
||||
10 CALL GETTOK
|
||||
IF (TT.LT.101.OR.TT.GT.199) CALL MUSTBE(ID)
|
||||
NARGS=NARGS+1
|
||||
|
||||
CALL ENTER_SYMBOL
|
||||
IF (SYMBOL_REF(SYMBOL_INDEX).EQ.S_ARG) THEN
|
||||
CALL ERROR('DUPLICATE ARG NAME: '//IDENTIFIER)
|
||||
GO TO 20
|
||||
ENDIF
|
||||
|
||||
SYMBOL_REF(SYMBOL_INDEX)=S_ARG
|
||||
SYMBOL_LINK(SYMBOL_INDEX)=PROC_LEVEL ! REMEMBER PROC_LEVEL.
|
||||
|
||||
IF (SYMBOL_REF(PROC_INDEX(PROC_LEVEL)).NE.S_EXT) THEN
|
||||
C ----- OOPS - DON'T KNOW YET IF PROC IS EXTERNAL ------
|
||||
CALL EMIT_ABSDEF(SYMBOL_VAX_ID(SYMBOL_INDEX),NARGS*4)
|
||||
ENDIF
|
||||
|
||||
20 CALL GETTOK
|
||||
IF (TT.EQ.D_COMMA) GO TO 10
|
||||
|
||||
CALL MATCH(D_RP)
|
||||
RETURN
|
||||
END
|
||||
C-------------------------------------------------------
|
||||
SUBROUTINE PROCEDURE_ATTRIBUTES(FLAGS,REF)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
FLAGS=0
|
||||
REF=S_LOCAL
|
||||
10 IF (TT.EQ.K_INTERRUPT) THEN
|
||||
CALL GETTOK
|
||||
FLAGS=FLAGS.OR.S_INTERRUPT
|
||||
CALL MATCH(FIXCON)
|
||||
ELSEIF (TT.EQ.K_REENTRANT) THEN
|
||||
CALL GETTOK
|
||||
FLAGS=FLAGS.OR.S_REENT
|
||||
ELSEIF (TT.EQ.K_PUBLIC.AND.REF.NE.S_EXT) THEN
|
||||
CALL GETTOK
|
||||
FLAGS=FLAGS.OR.S_PUBLIC
|
||||
ELSEIF (TT.EQ.K_EXTERNAL.AND.REF.EQ.S_LOCAL.AND.
|
||||
# (FLAGS.AND.S_PUBLIC).EQ.0) THEN
|
||||
CALL GETTOK
|
||||
REF=S_EXT
|
||||
ELSEIF (TT.EQ.K_FORWARD.AND.REF.EQ.S_LOCAL) THEN
|
||||
CALL GETTOK
|
||||
REF=S_FORWARD
|
||||
ELSE
|
||||
RETURN
|
||||
ENDIF
|
||||
GO TO 10
|
||||
END
|
||||
67
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/psects.for
Normal file
67
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/psects.for
Normal file
@@ -0,0 +1,67 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C PSECTS.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler handles changes in object
|
||||
C code program sections (PSECTs).
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 20OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 12NOV81 Alex Hunter 1. Add SETUP_COMMON_PSECT routine. (V6.1)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*2 FUNCTION PSECT(P)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*32 NAME
|
||||
DATA CURRENT_PSECT/P_CODE/
|
||||
|
||||
PSECT=CURRENT_PSECT
|
||||
IF (P.NE.CURRENT_PSECT.AND.P.NE.0) THEN
|
||||
CALL EMIT('.PSECT '//PSECT_NAME(P))
|
||||
ENDIF
|
||||
CURRENT_PSECT=P
|
||||
RETURN
|
||||
C-------------------------------------------------------
|
||||
ENTRY SETUP_COMMON_PSECT(NAME)
|
||||
C------------------------------------
|
||||
DO I=P_MEMORY,P_MAX
|
||||
IF (PSECT_NAME(I).EQ.NAME) THEN
|
||||
SETUP_COMMON_PSECT=I
|
||||
RETURN
|
||||
ELSEIF (PSECT_NAME(I).EQ.' ') THEN
|
||||
PSECT_NAME(I)=NAME
|
||||
CALL EMIT('.PSECT '//NAME(:LNB(NAME))//
|
||||
# ',PIC,OVR,GBL,SHR,NOEXE,RD,WRT,LONG')
|
||||
CURRENT_PSECT=I
|
||||
SETUP_COMMON_PSECT=I
|
||||
RETURN
|
||||
ENDIF
|
||||
ENDDO
|
||||
CALL FATAL('TOO MANY DIFFERENT COMMON BLOCKS')
|
||||
END
|
||||
94
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/publics.for
Normal file
94
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/publics.for
Normal file
@@ -0,0 +1,94 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C PUBLICS.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler generates the PUBLICS file
|
||||
C at the end of a compilation.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 20OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE OUTPUT_PUBLICS(MODULE_NAME)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*32 MODULE_NAME,PUBLIQUE
|
||||
|
||||
CHARACTER*1 REF_MNEM(11)
|
||||
DATA REF_MNEM
|
||||
//'X','S','B','A','F','D','C','V','U','I','L'/
|
||||
|
||||
CHARACTER*1 KIND_MNEM(6)
|
||||
DATA KIND_MNEM
|
||||
//'M','V','A','P','L','K'/
|
||||
|
||||
CHARACTER*1 TYPE_MNEM(-1:S_QUAD)
|
||||
DATA TYPE_MNEM
|
||||
//'S',' ','B','W','I','P','R','L','D','Q'/
|
||||
|
||||
CHARACTER*1 MREF,MKIND,MTYPE
|
||||
|
||||
IF (.NOT.PUBLICS_FLAG) RETURN
|
||||
|
||||
WRITE(PUB,1001) MODULE_NAME
|
||||
1001 FORMAT(' *M* ',A)
|
||||
|
||||
DO 100 I=SYMBOL_TOP(0)+1,SYMBOL_TOP(1)
|
||||
|
||||
IF (((SYMBOL_REF(I).EQ.S_EXT.OR.
|
||||
# (SYMBOL_FLAGS(I).AND.S_PUBLIC).NE.0)) .AND.
|
||||
# (SYMBOL_FLAGS(I).AND.S_NOTPUBLIC).EQ.0) THEN
|
||||
|
||||
TYPE=SYMBOL_TYPE(I)
|
||||
IF (TYPE.EQ.S_STRUC) TYPE=-1
|
||||
MTYPE=TYPE_MNEM(TYPE)
|
||||
|
||||
KIND=SYMBOL_KIND(I)
|
||||
MKIND=KIND_MNEM(KIND)
|
||||
MREF=REF_MNEM(SYMBOL_REF(I))
|
||||
|
||||
IF (KIND.EQ.S_PROC) THEN
|
||||
WRITE(PUB,1002) PUBLIQUE(SYMBOL_PLM_ID(I)),MREF,MTYPE,
|
||||
# MKIND,SYMBOL_LIST_SIZE(I)
|
||||
1002 FORMAT(X,A,X,3A1:'(',I5,')')
|
||||
|
||||
ELSEIF (KIND.EQ.S_ARRAY) THEN
|
||||
WRITE(PUB,1002) PUBLIQUE(SYMBOL_PLM_ID(I)),MREF,MTYPE,
|
||||
# MKIND,SYMBOL_NBR_ELEMENTS(I)
|
||||
|
||||
ELSE
|
||||
WRITE(PUB,1002) PUBLIQUE(SYMBOL_PLM_ID(I)),MREF,MTYPE,
|
||||
# MKIND
|
||||
ENDIF
|
||||
ENDIF
|
||||
100 CONTINUE
|
||||
|
||||
CLOSE (UNIT=PUB)
|
||||
|
||||
RETURN
|
||||
END
|
||||
74
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/push.for
Normal file
74
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/push.for
Normal file
@@ -0,0 +1,74 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C PUSH.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler implements the pushdown
|
||||
C stacks used by recursive FORTRAN subroutines and functions.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 20OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE PUSH(DATA,NWORDS)
|
||||
IMPLICIT INTEGER*2 (A-Z)
|
||||
INTEGER*2 DATA(*), SP, STACK(1000)
|
||||
DATA SP/0/
|
||||
C
|
||||
IF (SP+NWORDS.GT.1000) CALL FATAL('SYNTAX STACK OVERFLOW')
|
||||
DO 10 I=1,NWORDS
|
||||
STACK(SP+I) = DATA(I)
|
||||
10 CONTINUE
|
||||
SP = SP+NWORDS
|
||||
RETURN
|
||||
C------------------------------------------
|
||||
ENTRY POP(DATA,NWORDS)
|
||||
SP = SP-NWORDS
|
||||
IF (SP.LT.0) CALL BUG('SYNTAX STACK UNDERFLOW')
|
||||
DO 20 I=1,NWORDS
|
||||
DATA(I) = STACK(SP+I)
|
||||
20 CONTINUE
|
||||
RETURN
|
||||
END
|
||||
C------------------------------------------
|
||||
SUBROUTINE PUSHC(CHARS)
|
||||
IMPLICIT INTEGER*2 (A-Z)
|
||||
CHARACTER CHARS*(*), CSTACK(100)*32
|
||||
DATA SP/0/
|
||||
C
|
||||
IF (SP.GE.100) CALL FATAL('CHAR STACK OVERFLOW')
|
||||
SP=SP+1
|
||||
CSTACK(SP)=CHARS
|
||||
RETURN
|
||||
C------------------------------------------
|
||||
ENTRY POPC(CHARS)
|
||||
IF (SP.LE.0) CALL BUG('CHAR STACK UNDERFLOW')
|
||||
CHARS=CSTACK(SP)
|
||||
SP=SP-1
|
||||
RETURN
|
||||
END
|
||||
44
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/read.me
Normal file
44
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/read.me
Normal file
@@ -0,0 +1,44 @@
|
||||
February 4, 1982
|
||||
Alex Hunter
|
||||
|
||||
READ.ME
|
||||
|
||||
This directory contains the source for the PL/M-VAX compiler and
|
||||
the command files necessary to build the compiler from scratch.
|
||||
(The UDI directory which contains the PLMRUN runtime library is
|
||||
also required during the LINK phase of the PL/M-VAX compiler build.)
|
||||
|
||||
The source modules for the PL/M-VAX compiler are contained in the
|
||||
*.FOR and *.PLM files.
|
||||
|
||||
LOGNAMES.COM is a command file containing logical name assignments
|
||||
used by other command files in this directory. LOGNAMES.COM should
|
||||
be edited to reflect the directory names in use on your system.
|
||||
Any command file which makes use of system-dependent logical name
|
||||
assignments will contain a call to LOGNAMES.COM, so LOGNAMES.COM
|
||||
should be the only command file requiring editing.
|
||||
|
||||
The PLM.BLD file is the command file for doing a complete rebuild
|
||||
of the PL/M-VAX compiler.
|
||||
|
||||
PLM.CMP is a command file called by PLM.BLD to compile all the
|
||||
source modules of the PL/M-VAX compiler and place the object in
|
||||
library PLMCOM.OLB.
|
||||
|
||||
PLM.LNK is a command file called by PLM.BLD to link the PL/M-VAX
|
||||
compiler into an executable image. (PLM.LNK may be invoked by
|
||||
itself whenever one or more source modules have been recompiled
|
||||
and PLMCOM.OLB has been updated.)
|
||||
|
||||
PLM.EXE is the executable image of the PL/M-VAX compiler.
|
||||
|
||||
COMLIST.COM and EXLIST.COM are handy command files for listing
|
||||
the source of the PL/M-VAX compiler.
|
||||
|
||||
ERRFIND.COM is a command file used to search source files for
|
||||
calls to the error message routines. (Requires the WYLBUR text
|
||||
editor.)
|
||||
|
||||
MAKETAPE.COM is the command file used to write the contents of this
|
||||
directory to mag tape.
|
||||
|
||||
44
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/readme.md
Normal file
44
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/readme.md
Normal file
@@ -0,0 +1,44 @@
|
||||
February 4, 1982
|
||||
Alex Hunter
|
||||
|
||||
READ.ME
|
||||
|
||||
This directory contains the source for the PL/M-VAX compiler and
|
||||
the command files necessary to build the compiler from scratch.
|
||||
(The UDI directory which contains the PLMRUN runtime library is
|
||||
also required during the LINK phase of the PL/M-VAX compiler build.)
|
||||
|
||||
The source modules for the PL/M-VAX compiler are contained in the
|
||||
*.FOR and *.PLM files.
|
||||
|
||||
LOGNAMES.COM is a command file containing logical name assignments
|
||||
used by other command files in this directory. LOGNAMES.COM should
|
||||
be edited to reflect the directory names in use on your system.
|
||||
Any command file which makes use of system-dependent logical name
|
||||
assignments will contain a call to LOGNAMES.COM, so LOGNAMES.COM
|
||||
should be the only command file requiring editing.
|
||||
|
||||
The PLM.BLD file is the command file for doing a complete rebuild
|
||||
of the PL/M-VAX compiler.
|
||||
|
||||
PLM.CMP is a command file called by PLM.BLD to compile all the
|
||||
source modules of the PL/M-VAX compiler and place the object in
|
||||
library PLMCOM.OLB.
|
||||
|
||||
PLM.LNK is a command file called by PLM.BLD to link the PL/M-VAX
|
||||
compiler into an executable image. (PLM.LNK may be invoked by
|
||||
itself whenever one or more source modules have been recompiled
|
||||
and PLMCOM.OLB has been updated.)
|
||||
|
||||
PLM.EXE is the executable image of the PL/M-VAX compiler.
|
||||
|
||||
COMLIST.COM and EXLIST.COM are handy command files for listing
|
||||
the source of the PL/M-VAX compiler.
|
||||
|
||||
ERRFIND.COM is a command file used to search source files for
|
||||
calls to the error message routines. (Requires the WYLBUR text
|
||||
editor.)
|
||||
|
||||
MAKETAPE.COM is the command file used to write the contents of this
|
||||
directory to mag tape.
|
||||
|
||||
139
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/regs.for
Normal file
139
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/regs.for
Normal file
@@ -0,0 +1,139 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C REGS.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler contains routines to manage
|
||||
C register allocation and preservation.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C 15OCT81 Alex Hunter 1. Experimental version. (V54.)
|
||||
C 14NOV81 Alex Hunter 1. If LARGE OVERLAY, then add R12 to
|
||||
C register pool. (V6.2)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*2 FUNCTION ALLOCATE_REG_WITH_PREFERENCE(TYPE,POSSIBLE_REG)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
INTEGER*4 LAST_REG,FIRST_REG,R
|
||||
LOGICAL*4 AVAILABLE(1:16)
|
||||
|
||||
R = POSSIBLE_REG
|
||||
|
||||
C------- First try to allocate the preferred register.
|
||||
|
||||
IF (REGISTER(R) .AND. AVAILABLE(R) .AND.
|
||||
# (BYTE_SIZE(TYPE).LE.4 .OR. AVAILABLE(R+1))) GO TO 10
|
||||
|
||||
C------- Otherwise, use the normal allocation algorithm.
|
||||
|
||||
C---------------------------------------------
|
||||
ENTRY ALLOCATE_REG(TYPE)
|
||||
C---------------------------------------------
|
||||
DO R = LAST_REG-1, FIRST_REG, -1
|
||||
IF (AVAILABLE(R) .AND.
|
||||
# (BYTE_SIZE(TYPE).LE.4 .OR. AVAILABLE(R+1))) GO TO 10
|
||||
ENDDO
|
||||
|
||||
CALL ERROR('REGISTER POOL EXHAUSTED')
|
||||
ALLOCATE_REG = LAST_REG-1 ! Just so we can keep compiling.
|
||||
NODE_TYPE(ALLOCATE_REG) = TYPE
|
||||
RETURN
|
||||
|
||||
C------- Here when we have an available register.
|
||||
|
||||
10 CONTINUE
|
||||
ALLOCATE_REG = R
|
||||
CALL PRESERVE_REG(R)
|
||||
AVAILABLE(R) = .FALSE.
|
||||
NODE_TYPE(R) = TYPE
|
||||
IF (BYTE_SIZE(TYPE).GT.4) THEN
|
||||
CALL PRESERVE_REG(R+1)
|
||||
AVAILABLE(R+1) = .FALSE.
|
||||
NODE_TYPE(R+1) = TYPE
|
||||
ENDIF
|
||||
RETURN
|
||||
C--------------------------------------
|
||||
ENTRY FREE_REGS()
|
||||
C--------------------------------------
|
||||
IF (MODEL.EQ.4.AND.OVERLAY_FLAG) THEN
|
||||
LAST_REG=12
|
||||
ELSEIF (MODEL.EQ.2 .OR. MODEL.EQ.4) THEN
|
||||
LAST_REG=11
|
||||
ELSE
|
||||
LAST_REG=10
|
||||
ENDIF
|
||||
FIRST_REG=PROC_AP(PROC_LEVEL)+1
|
||||
DO R=1,LAST_REG
|
||||
AVAILABLE(R) = R.GE.FIRST_REG .AND. R.LT.LAST_REG
|
||||
ENDDO
|
||||
RETURN
|
||||
C--------------------------------------
|
||||
ENTRY FREE_REG(REG)
|
||||
C--------------------------------------
|
||||
AVAILABLE(REG) = .TRUE.
|
||||
IF (BYTE_SIZE(NODE_TYPE(REG)).GT.4) THEN
|
||||
AVAILABLE(REG+1) = .TRUE.
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
C-------------------------------------------------------
|
||||
SUBROUTINE PRESERVE_REG(REG)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
PROC_ENTRY_MASK(PROC_LEVEL)=PROC_ENTRY_MASK(PROC_LEVEL).OR.
|
||||
# ISHFT(1,REG)
|
||||
RETURN
|
||||
END
|
||||
C--------------------------------------------------------
|
||||
CHARACTER*40 FUNCTION REGISTER_MASK(MASK)
|
||||
IMPLICIT INTEGER*2 (A-Z)
|
||||
CHARACTER*3 REGNAME(0:15)
|
||||
DATA REGNAME
|
||||
//'R0','R1','R2','R3','R4','R5','R6','R7','R8','R9'
|
||||
,,'R10','R11','AP','FP','SP','PC'
|
||||
//
|
||||
INTEGER*2 REGLEN(0:15)
|
||||
DATA REGLEN
|
||||
//2,2,2,2,2,2,2,2,2,2,3,3,2,2,2,2/
|
||||
|
||||
REGISTER_MASK='^M<'
|
||||
N=4
|
||||
|
||||
DO 10 I=0,15
|
||||
IF ((ISHFT(MASK,-I).AND.1).NE.0) THEN
|
||||
IF (N.GT.4) THEN
|
||||
REGISTER_MASK(N:)=','
|
||||
N=N+1
|
||||
ENDIF
|
||||
REGISTER_MASK(N:)=REGNAME(I)
|
||||
N=N+REGLEN(I)
|
||||
ENDIF
|
||||
10 CONTINUE
|
||||
|
||||
REGISTER_MASK(N:)='>'
|
||||
|
||||
RETURN
|
||||
END
|
||||
89
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/replica.for
Normal file
89
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/replica.for
Normal file
@@ -0,0 +1,89 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C REPLICA.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler replicates (i.e., creates a
|
||||
C copy of) a code tree.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 29SEP81 Alex Hunter 1. Correct bug in replicating register nodes
|
||||
C (e.g., for STACK$PTR). (V5.3)
|
||||
C 2. Add consistency check REP-0.
|
||||
C 24OCT81 Alex Hunter 1. Replicate serial no field of atom. (V5.6)
|
||||
C
|
||||
C***********************************************************************
|
||||
INTEGER*2 FUNCTION REPLICA(NODX)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
NOD=NODX
|
||||
|
||||
IF (NOD.EQ.NULL.OR.CONSTANT(NOD).OR.REGISTER(NOD)) THEN
|
||||
REPLICA=NOD
|
||||
|
||||
ELSEIF (ATOM(NOD)) THEN
|
||||
REPLICA=MAKE_ATOM(ATOM_SYM(NOD),ATOM_MEM(NOD),ATOM_BASE(NOD),
|
||||
# ATOM_SUB(NOD),NODE_TYPE(NOD),NODE_REG(NOD),
|
||||
# NODE_REFCT(NOD))
|
||||
ATOM_DISP(REPLICA)=ATOM_DISP(NOD)
|
||||
ATOM_FLAGS(REPLICA)=ATOM_FLAGS(NOD)
|
||||
ATOM_SERIAL_NO(REPLICA)=ATOM_SERIAL_NO(NOD)
|
||||
|
||||
ELSEIF (FIXLIT(NOD)) THEN
|
||||
REPLICA=MAKE_FIXED(FIXED_VAL(NOD),NODE_TYPE(NOD))
|
||||
|
||||
ELSEIF (FLOATLIT(NOD)) THEN
|
||||
REPLICA=MAKE_FLOAT(FLOAT_VAL(NOD),NODE_TYPE(NOD))
|
||||
|
||||
ELSEIF (NODE(NOD)) THEN
|
||||
|
||||
CALL PUSH(NOD,1)
|
||||
OPND1=REPLICA2(OPNODE_OPND1(NOD))
|
||||
CALL POP(NOD,1)
|
||||
CALL PUSH(NOD,1)
|
||||
CALL PUSH(OPND1,1)
|
||||
OPND2=REPLICA2(OPNODE_OPND2(NOD))
|
||||
CALL POP(OPND1,1)
|
||||
CALL POP(NOD,1)
|
||||
|
||||
REPLICA=MAKE_NODE(OPNODE_OP(NOD),OPND1,OPND2,NODE_TYPE(NOD),
|
||||
# NODE_REG(NOD),NODE_REFCT(NOD))
|
||||
|
||||
ELSE
|
||||
CALL BUG('REP-0')
|
||||
ENDIF
|
||||
|
||||
RETURN
|
||||
END
|
||||
C-------------------------------------------------------------------
|
||||
INTEGER*2 FUNCTION REPLICA2(NODX)
|
||||
IMPLICIT INTEGER*2 (A-Z)
|
||||
REPLICA2=REPLICA(NODX)
|
||||
RETURN
|
||||
END
|
||||
164
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/savetree.for
Normal file
164
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/savetree.for
Normal file
@@ -0,0 +1,164 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C SAVETREE.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler contains routines to save
|
||||
C and restore the current code tree.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 20OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 24OCT81 Alex Hunter 1. Save and restore atom serial no. (V5.6)
|
||||
C 12NOV81 Alex Hunter 1. Change ATOM_DISP to I*4. (V6.1)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE SAVE_CODE_TREE
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
N=NEXT_NODE-NODE_MIN
|
||||
IF (N.GT.0) THEN
|
||||
CALL PUSH(OPNODE_OP(NODE_MIN),N)
|
||||
CALL PUSH(OPNODE_OPND1(NODE_MIN),N)
|
||||
CALL PUSH(OPNODE_OPND2(NODE_MIN),N)
|
||||
CALL PUSH(NODE_REG(NODE_MIN),N)
|
||||
CALL PUSH(NODE_REFCT(NODE_MIN),N)
|
||||
CALL PUSH(NODE_TYPE(NODE_MIN),N)
|
||||
CALL PUSH(NODE_CONTEXT(NODE_MIN),N)
|
||||
ENDIF
|
||||
CALL PUSH(NEXT_NODE,1)
|
||||
|
||||
N=NEXT_ATOM-FIRST_FREE_ATOM
|
||||
IF (N.GT.0) THEN
|
||||
CALL PUSH(ATOM_SYM(FIRST_FREE_ATOM),N)
|
||||
CALL PUSH(ATOM_MEM(FIRST_FREE_ATOM),N)
|
||||
CALL PUSH(ATOM_BASE(FIRST_FREE_ATOM),N)
|
||||
CALL PUSH(ATOM_SUB(FIRST_FREE_ATOM),N)
|
||||
CALL PUSH(ATOM_DISP(FIRST_FREE_ATOM),N*2)
|
||||
CALL PUSH(ATOM_FLAGS(FIRST_FREE_ATOM),N)
|
||||
CALL PUSH(ATOM_SERIAL_NO(FIRST_FREE_ATOM),N)
|
||||
CALL PUSH(NODE_REG(FIRST_FREE_ATOM),N)
|
||||
CALL PUSH(NODE_REFCT(FIRST_FREE_ATOM),N)
|
||||
CALL PUSH(NODE_TYPE(FIRST_FREE_ATOM),N)
|
||||
CALL PUSH(NODE_CONTEXT(FIRST_FREE_ATOM),N)
|
||||
ENDIF
|
||||
CALL PUSH(NEXT_ATOM,1)
|
||||
|
||||
N=NEXT_FIXED-FIX_MIN
|
||||
IF (N.GT.0) THEN
|
||||
CALL PUSH(FIXED_VAL(FIX_MIN),N*2)
|
||||
CALL PUSH(NODE_REG(FIX_MIN),N)
|
||||
CALL PUSH(NODE_REFCT(FIX_MIN),N)
|
||||
CALL PUSH(NODE_TYPE(FIX_MIN),N)
|
||||
CALL PUSH(NODE_CONTEXT(FIX_MIN),N)
|
||||
ENDIF
|
||||
CALL PUSH(NEXT_FIXED,1)
|
||||
|
||||
N=NEXT_FLOAT-FLT_MIN
|
||||
IF (N.GT.0) THEN
|
||||
CALL PUSH(FLOAT_VAL(FLT_MIN),N*4)
|
||||
CALL PUSH(NODE_REG(FLT_MIN),N)
|
||||
CALL PUSH(NODE_REFCT(FLT_MIN),N)
|
||||
CALL PUSH(NODE_TYPE(FLT_MIN),N)
|
||||
CALL PUSH(NODE_CONTEXT(FLT_MIN),N)
|
||||
ENDIF
|
||||
CALL PUSH(NEXT_FLOAT,1)
|
||||
|
||||
N=NEXT_CONSTANT-CON_MIN
|
||||
IF (N.GT.0) THEN
|
||||
CALL PUSH(CONSTANT_LABEL(CON_MIN),N)
|
||||
CALL PUSH(NODE_REG(CON_MIN),N)
|
||||
CALL PUSH(NODE_REFCT(CON_MIN),N)
|
||||
CALL PUSH(NODE_TYPE(CON_MIN),N)
|
||||
CALL PUSH(NODE_CONTEXT(CON_MIN),N)
|
||||
ENDIF
|
||||
CALL PUSH(NEXT_CONSTANT,1)
|
||||
RETURN
|
||||
|
||||
C-------------------------------
|
||||
ENTRY RESTORE_CODE_TREE
|
||||
C-------------------------------
|
||||
|
||||
CALL POP(NEXT_CONSTANT,1)
|
||||
N=NEXT_CONSTANT-CON_MIN
|
||||
IF (N.GT.0) THEN
|
||||
CALL POP(NODE_CONTEXT(CON_MIN),N)
|
||||
CALL POP(NODE_TYPE(CON_MIN),N)
|
||||
CALL POP(NODE_REFCT(CON_MIN),N)
|
||||
CALL POP(NODE_REG(CON_MIN),N)
|
||||
CALL POP(CONSTANT_LABEL(CON_MIN),N)
|
||||
ENDIF
|
||||
|
||||
CALL POP(NEXT_FLOAT,1)
|
||||
N=NEXT_FLOAT-FLT_MIN
|
||||
IF (N.GT.0) THEN
|
||||
CALL POP(NODE_CONTEXT(FLT_MIN),N)
|
||||
CALL POP(NODE_TYPE(FLT_MIN),N)
|
||||
CALL POP(NODE_REFCT(FLT_MIN),N)
|
||||
CALL POP(NODE_REG(FLT_MIN),N)
|
||||
CALL POP(FLOAT_VAL(FLT_MIN),N*4)
|
||||
ENDIF
|
||||
|
||||
CALL POP(NEXT_FIXED,1)
|
||||
N=NEXT_FIXED-FIX_MIN
|
||||
IF (N.GT.0) THEN
|
||||
CALL POP(NODE_CONTEXT(FIX_MIN),N)
|
||||
CALL POP(NODE_TYPE(FIX_MIN),N)
|
||||
CALL POP(NODE_REFCT(FIX_MIN),N)
|
||||
CALL POP(NODE_REG(FIX_MIN),N)
|
||||
CALL POP(FIXED_VAL(FIX_MIN),N*2)
|
||||
ENDIF
|
||||
|
||||
CALL POP(NEXT_ATOM,1)
|
||||
N=NEXT_ATOM-FIRST_FREE_ATOM
|
||||
IF (N.GT.0) THEN
|
||||
CALL POP(NODE_CONTEXT(FIRST_FREE_ATOM),N)
|
||||
CALL POP(NODE_TYPE(FIRST_FREE_ATOM),N)
|
||||
CALL POP(NODE_REFCT(FIRST_FREE_ATOM),N)
|
||||
CALL POP(NODE_REG(FIRST_FREE_ATOM),N)
|
||||
CALL POP(ATOM_SERIAL_NO(FIRST_FREE_ATOM),N)
|
||||
CALL POP(ATOM_FLAGS(FIRST_FREE_ATOM),N)
|
||||
CALL POP(ATOM_DISP(FIRST_FREE_ATOM),N*2)
|
||||
CALL POP(ATOM_SUB(FIRST_FREE_ATOM),N)
|
||||
CALL POP(ATOM_BASE(FIRST_FREE_ATOM),N)
|
||||
CALL POP(ATOM_MEM(FIRST_FREE_ATOM),N)
|
||||
CALL POP(ATOM_SYM(FIRST_FREE_ATOM),N)
|
||||
ENDIF
|
||||
|
||||
CALL POP(NEXT_NODE,1)
|
||||
N=NEXT_NODE-NODE_MIN
|
||||
IF (N.GT.0) THEN
|
||||
CALL POP(NODE_CONTEXT(NODE_MIN),N)
|
||||
CALL POP(NODE_TYPE(NODE_MIN),N)
|
||||
CALL POP(NODE_REFCT(NODE_MIN),N)
|
||||
CALL POP(NODE_REG(NODE_MIN),N)
|
||||
CALL POP(OPNODE_OPND2(NODE_MIN),N)
|
||||
CALL POP(OPNODE_OPND1(NODE_MIN),N)
|
||||
CALL POP(OPNODE_OP(NODE_MIN),N)
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
419
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/scopes.for
Normal file
419
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/scopes.for
Normal file
@@ -0,0 +1,419 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C SCOPES.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler processes END statements,
|
||||
C IF statements, ELSE statements, and DO statements.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 20OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 21OCT81 Alex Hunter 1. Basic block analysis. (V5.5)
|
||||
C 10NOV81 Alex Hunter 1. Fix DRC bugs. (V6.0)
|
||||
C 14JAN82 Alex Hunter 1. Allow END <keyword>. (V6.5)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE END_STATEMENT
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CALL MATCH(K_END)
|
||||
CALL POPC(LAST_LABEL)
|
||||
IF (TT.EQ.ID .OR. TT.GE.101.AND.TT.LE.199) THEN
|
||||
IF (LAST_LABEL.NE.IDENTIFIER) THEN
|
||||
CALL ERROR('END DOESN''T MATCH '//LAST_LABEL)
|
||||
ENDIF
|
||||
CALL GETTOK
|
||||
ENDIF
|
||||
CALL MATCH(D_SEMI)
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*2 FUNCTION CONDITIONAL_CLAUSE(N)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CALL MATCH(K_IF)
|
||||
CALL BREAK ! For now.
|
||||
CONDITION=MASSAGE(EXPRESSION(1),CX_UNSIGNED)
|
||||
CALL GENERATE_LOCAL_LABEL(LL0)
|
||||
CALL GENERATE_LOCAL_LABEL(LL1)
|
||||
CALL GENERATE_LOCAL_LABEL(LL2)
|
||||
CALL BRANCH_TO(CONDITION,LL1,LL0,LL0)
|
||||
CALL EMIT_LOCAL_LABEL(LL0)
|
||||
CALL EMIT('BRW '//LOCAL_LABEL(LL2,N0))
|
||||
CALL EMIT_LOCAL_LABEL(LL1)
|
||||
CALL MATCH(K_THEN)
|
||||
CALL PUSH(LL2,1)
|
||||
CALL BREAK
|
||||
CALL UNIT
|
||||
CALL BREAK
|
||||
CALL POP(LL2,1)
|
||||
IF (TT.EQ.K_ELSE) THEN
|
||||
CALL GETTOK
|
||||
IF (PATH) THEN
|
||||
CALL GENERATE_LOCAL_LABEL(LL3)
|
||||
CALL EMIT('BRW '//LOCAL_LABEL(LL3,N0))
|
||||
ELSE
|
||||
LL3=0
|
||||
ENDIF
|
||||
CALL EMIT_LOCAL_LABEL(LL2)
|
||||
CALL PUSH(LL3,1)
|
||||
CALL UNIT
|
||||
CALL BREAK
|
||||
CALL POP(LL3,1)
|
||||
CALL EMIT_LOCAL_LABEL(LL3)
|
||||
ELSE
|
||||
CALL EMIT_LOCAL_LABEL(LL2)
|
||||
ENDIF
|
||||
CONDITIONAL_CLAUSE=NULL
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*2 FUNCTION DO_BLOCK(N)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CALL PUSHC(LAST_LABEL)
|
||||
CALL MATCH(K_DO)
|
||||
IF (TT.EQ.D_SEMI) THEN
|
||||
CALL GETTOK
|
||||
CALL BLOCK_BEGIN
|
||||
CALL DECLARATIONS
|
||||
CALL UNITS
|
||||
CALL BLOCK_END
|
||||
CALL END_STATEMENT
|
||||
ELSEIF (TT.EQ.K_CASE) THEN
|
||||
CALL DO_CASE_BLOCK
|
||||
ELSEIF (TT.EQ.K_WHILE) THEN
|
||||
CALL BREAK ! For now.
|
||||
CALL GETTOK
|
||||
CALL GENERATE_LOCAL_LABEL(LL0)
|
||||
CALL GENERATE_LOCAL_LABEL(LL1)
|
||||
CALL GENERATE_LOCAL_LABEL(LL2)
|
||||
CALL GENERATE_LOCAL_LABEL(LL3)
|
||||
CALL EMIT_LOCAL_LABEL(LL1)
|
||||
CONDITION=MASSAGE(EXPRESSION(1),CX_UNSIGNED)
|
||||
CALL MATCH(D_SEMI)
|
||||
IF (FIXLIT(CONDITION)) THEN
|
||||
IF ((FIXED_VAL(CONDITION).AND.1).NE.0) THEN
|
||||
LL3=0 ! DO WHILE TRUE.
|
||||
ELSE
|
||||
! DO WHILE FALSE.
|
||||
CALL EMIT('BRW '//LOCAL_LABEL(LL3,N0))
|
||||
PATH=.FALSE.
|
||||
ENDIF
|
||||
ELSE
|
||||
CALL BRANCH_TO(CONDITION,LL2,LL0,LL0)
|
||||
CALL EMIT_LOCAL_LABEL(LL0)
|
||||
CALL EMIT('BRW '//LOCAL_LABEL(LL3,N0))
|
||||
CALL EMIT_LOCAL_LABEL(LL2)
|
||||
ENDIF
|
||||
CALL PUSH(LL1,1)
|
||||
CALL PUSH(LL3,1)
|
||||
CALL BREAK
|
||||
CALL UNITS
|
||||
CALL BREAK
|
||||
CALL END_STATEMENT
|
||||
CALL POP(LL3,1)
|
||||
CALL POP(LL1,1)
|
||||
IF (PATH) CALL EMIT('BRW '//LOCAL_LABEL(LL1,N0))
|
||||
PATH=.FALSE.
|
||||
CALL EMIT_LOCAL_LABEL(LL3)
|
||||
ELSE
|
||||
CALL ITERATIVE_DO_BLOCK
|
||||
ENDIF
|
||||
DO_BLOCK=NULL
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE ITERATIVE_DO_BLOCK
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*80 OPERAND,OPERAND1,OPERAND2,OPERAND3
|
||||
INTEGER*2 PROMOTE(1:6)
|
||||
DATA PROMOTE /
|
||||
# S_WORD,S_LONG,S_INTEGER,S_PTR,S_REAL,S_LONG/
|
||||
CHARACTER*6 ACB(1:6)
|
||||
DATA ACB/
|
||||
# 'ACBB','ACBW','ACBW','ACBL','ACBF','ACBL'/
|
||||
|
||||
CALL BREAK ! For now.
|
||||
CALL SIMPLE_VARIABLE(DTYPE)
|
||||
INDEX=MAKE_ATOM(SYMBOL_INDEX,MEMBER_INDEX,NULL,NULL,DTYPE,0,0)
|
||||
CALL MATCH(D_EQ)
|
||||
START=EXPRESSION(1)
|
||||
CALL MATCH(K_TO)
|
||||
LIMIT=EXPRESSION(1)
|
||||
IF (TT.EQ.K_BY) THEN
|
||||
CALL GETTOK
|
||||
STEP=EXPRESSION(1)
|
||||
ELSE
|
||||
STEP=MAKE_FIXED(1,0)
|
||||
ENDIF
|
||||
|
||||
CALL RESOLVE_CONTEXT(START)
|
||||
CALL RESOLVE_CONTEXT(STEP)
|
||||
CALL RESOLVE_CONTEXT(LIMIT)
|
||||
|
||||
DCX=CONTEXT(DTYPE)
|
||||
IF (NODE_CONTEXT(START).EQ.0) CALL SET_CONTEXT(START,DCX)
|
||||
IF (NODE_CONTEXT(STEP).EQ.0) CALL SET_CONTEXT(STEP,DCX)
|
||||
IF (NODE_CONTEXT(LIMIT).EQ.0) CALL SET_CONTEXT(LIMIT,DCX)
|
||||
|
||||
CALL COERCE_TYPES(START)
|
||||
CALL COERCE_TYPES(STEP)
|
||||
CALL COERCE_TYPES(LIMIT)
|
||||
|
||||
FTYPE=PROMOTE(DTYPE)
|
||||
START=FORCE_TYPE(START,FTYPE)
|
||||
STEP=FORCE_TYPE(STEP,FTYPE)
|
||||
LIMIT=FORCE_TYPE(LIMIT,FTYPE)
|
||||
|
||||
START=FOLD_CONSTANTS(START)
|
||||
STEP=FOLD_CONSTANTS(STEP)
|
||||
LIMIT=FOLD_CONSTANTS(LIMIT)
|
||||
|
||||
IF (FTYPE.EQ.DTYPE) THEN
|
||||
WHERE=INDEX
|
||||
ELSE
|
||||
WHERE=R0
|
||||
NODE_TYPE(R0)=FTYPE
|
||||
NODE_REG(R0)=R0
|
||||
ENDIF
|
||||
|
||||
CALL SAVE_CODE_TREE
|
||||
|
||||
CALL PUSH(INDEX,1)
|
||||
CALL PUSH(STEP,1)
|
||||
CALL PUSH(LIMIT,1)
|
||||
CALL PUSH(DTYPE,1)
|
||||
CALL PUSH(FTYPE,1)
|
||||
CALL PUSH(WHERE,1)
|
||||
|
||||
CALL GENERATE_LOCAL_LABEL(LL1)
|
||||
LL2=0
|
||||
LL3=0
|
||||
|
||||
IF (LITERAL(START).AND.LITERAL(STEP).AND.LITERAL(LIMIT)) THEN
|
||||
CALL COMPUTE_REFERENCE_COUNTS(START)
|
||||
XX=GET_SOMEWHERE(START,WHERE)
|
||||
|
||||
IF (DTYPE.EQ.S_REAL .AND.
|
||||
# (FLOAT_VAL(STEP).LT.0.0 .AND.
|
||||
# FLOAT_VAL(START).LT.FLOAT_VAL(LIMIT)
|
||||
# .OR. FLOAT_VAL(STEP).GE.0.0 .AND.
|
||||
# FLOAT_VAL(START).GT.FLOAT_VAL(LIMIT))
|
||||
# .OR. DTYPE.NE.S_REAL .AND.
|
||||
# (FIXED_VAL(STEP).LT.0 .AND.
|
||||
# FIXED_VAL(START).LT.FIXED_VAL(LIMIT)
|
||||
# .OR. FIXED_VAL(STEP).GE.0 .AND.
|
||||
# FIXED_VAL(START).GT.FIXED_VAL(LIMIT))) THEN
|
||||
|
||||
CALL GENERATE_LOCAL_LABEL(LL3)
|
||||
CALL EMIT('BRW '//LOCAL_LABEL(LL3,N0))
|
||||
ENDIF
|
||||
|
||||
ELSE
|
||||
INIT=MAKE_NODE(OP_SUB,START,STEP,FTYPE,0,0)
|
||||
INIT=FOLD_CONSTANTS(INIT)
|
||||
INIT=MERGE(INIT)
|
||||
CALL COMPUTE_REFERENCE_COUNTS(INIT)
|
||||
XX=GET_SOMEWHERE(INIT,WHERE)
|
||||
CALL GENERATE_LOCAL_LABEL(LL2)
|
||||
CALL EMIT('BRW '//LOCAL_LABEL(LL2,N0))
|
||||
ENDIF
|
||||
|
||||
CALL EMIT_LOCAL_LABEL(LL1)
|
||||
|
||||
IF (INDEX.NE.WHERE) THEN
|
||||
CODE=FORCE_TYPE(WHERE,DTYPE)
|
||||
CALL COMPUTE_REFERENCE_COUNTS(CODE)
|
||||
XX=GET_SOMEWHERE(CODE,INDEX)
|
||||
ENDIF
|
||||
|
||||
CALL PUSH(LL1,1)
|
||||
CALL PUSH(LL2,1)
|
||||
CALL PUSH(LL3,1)
|
||||
|
||||
CALL MATCH(D_SEMI)
|
||||
CALL BREAK
|
||||
CALL UNITS
|
||||
CALL BREAK
|
||||
|
||||
CALL POP(LL3,1)
|
||||
CALL POP(LL2,1)
|
||||
CALL POP(LL1,1)
|
||||
|
||||
CALL POP(WHERE,1)
|
||||
CALL POP(FTYPE,1)
|
||||
CALL POP(DTYPE,1)
|
||||
CALL POP(LIMIT,1)
|
||||
CALL POP(STEP,1)
|
||||
CALL POP(INDEX,1)
|
||||
|
||||
CALL RESTORE_CODE_TREE
|
||||
|
||||
IF (INDEX.NE.WHERE) THEN
|
||||
NODE_TYPE(R0)=FTYPE
|
||||
NODE_REG(R0)=R0
|
||||
CODE=FORCE_TYPE(INDEX,FTYPE)
|
||||
CALL COMPUTE_REFERENCE_COUNTS(CODE)
|
||||
XX=GET_SOMEWHERE(CODE,WHERE)
|
||||
ENDIF
|
||||
|
||||
IF (LL2.NE.0) CALL EMIT_LOCAL_LABEL(LL2)
|
||||
|
||||
LIMIT=MERGE(LIMIT)
|
||||
CALL COMPUTE_REFERENCE_COUNTS(LIMIT)
|
||||
STEP=MERGE(STEP)
|
||||
CALL COMPUTE_REFERENCE_COUNTS(STEP)
|
||||
|
||||
OPND1=GET_SOMEWHERE(LIMIT,ANY_WHERE)
|
||||
OPND2=GET_SOMEWHERE(STEP,ANY_WHERE)
|
||||
|
||||
OPERAND1=OPERAND(OPND1,N1)
|
||||
OPERAND2=OPERAND(OPND2,N2)
|
||||
OPERAND3=OPERAND(WHERE,N3)
|
||||
|
||||
CALL EMIT(ACB(FTYPE)//' '//OPERAND1(:N1)//','//OPERAND2(:N2)//
|
||||
# ','//OPERAND3(:N3)//','//LOCAL_LABEL(LL1,N0))
|
||||
|
||||
IF (LL3.NE.0) CALL EMIT_LOCAL_LABEL(LL3)
|
||||
|
||||
IF (INDEX.NE.WHERE) THEN
|
||||
CODE=FORCE_TYPE(WHERE,DTYPE)
|
||||
CALL COMPUTE_REFERENCE_COUNTS(CODE)
|
||||
XX=GET_SOMEWHERE(CODE,INDEX)
|
||||
ENDIF
|
||||
|
||||
CALL BREAK
|
||||
CALL END_STATEMENT
|
||||
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE DO_CASE_BLOCK
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*80 OPERAND,OPERAND1,OPERAND2
|
||||
CHARACTER*32 LLL98,LLL
|
||||
CHARACTER*6 CASE(1:6)
|
||||
DATA CASE/
|
||||
# 'CASEB','CASEW','CASEW','----','----','CASEL'/
|
||||
INTEGER*2 LL(0:255)
|
||||
|
||||
CALL BREAK ! For now.
|
||||
CALL GETTOK
|
||||
SELECTOR=EXPRESSION(1)
|
||||
|
||||
CALL RESOLVE_CONTEXT(SELECTOR)
|
||||
IF (NODE_CONTEXT(SELECTOR).EQ.0)
|
||||
# CALL SET_CONTEXT(SELECTOR,CX_UNSIGNED)
|
||||
CALL COERCE_TYPES(SELECTOR)
|
||||
IF (NODE_TYPE(SELECTOR).EQ.S_PTR .OR.
|
||||
# NODE_TYPE(SELECTOR).EQ.S_REAL .OR.
|
||||
# NODE_TYPE(SELECTOR).GT.S_LONG) THEN
|
||||
SELECTOR=FORCE_TYPE(SELECTOR,S_LONG)
|
||||
ENDIF
|
||||
|
||||
SELECTOR=FOLD_CONSTANTS(SELECTOR)
|
||||
SELECTOR=MERGE(SELECTOR)
|
||||
CALL COMPUTE_REFERENCE_COUNTS(SELECTOR)
|
||||
|
||||
CALL SAVE_CODE_TREE
|
||||
CALL PUSH(SELECTOR,1)
|
||||
|
||||
CALL GENERATE_LOCAL_LABEL(LL97)
|
||||
CALL GENERATE_LOCAL_LABEL(LL98)
|
||||
CALL GENERATE_LOCAL_LABEL(LL99)
|
||||
|
||||
CALL EMIT('BRW '//LOCAL_LABEL(LL97,N0))
|
||||
|
||||
CALL PUSH(LL97,1)
|
||||
CALL PUSH(LL98,1)
|
||||
|
||||
I=-1
|
||||
|
||||
CALL MATCH(D_SEMI)
|
||||
|
||||
10 IF (TT.NE.K_END) THEN
|
||||
IF (I.GE.255) THEN
|
||||
CALL ERROR('TOO MANY CASES')
|
||||
ELSE
|
||||
I=I+1
|
||||
CALL GENERATE_LOCAL_LABEL(LL0)
|
||||
CALL EMIT_LOCAL_LABEL(LL0)
|
||||
CALL PUSH(LL0,1)
|
||||
ENDIF
|
||||
|
||||
CALL PUSH(LL99,1)
|
||||
CALL PUSH(I,1)
|
||||
|
||||
CALL UNIT
|
||||
CALL BREAK
|
||||
|
||||
CALL POP(I,1)
|
||||
CALL POP(LL99,1)
|
||||
|
||||
IF (PATH) THEN
|
||||
CALL EMIT('BRW '//LOCAL_LABEL(LL99,N0))
|
||||
ENDIF
|
||||
|
||||
GO TO 10
|
||||
ENDIF
|
||||
|
||||
DO 15 J=I,0,-1
|
||||
CALL POP(LL(J),1)
|
||||
15 CONTINUE
|
||||
|
||||
CALL POP(LL98,1)
|
||||
CALL POP(LL97,1)
|
||||
CALL POP(SELECTOR,1)
|
||||
CALL RESTORE_CODE_TREE
|
||||
|
||||
CALL EMIT_LOCAL_LABEL(LL97)
|
||||
|
||||
IF (I.GE.0) THEN
|
||||
OPND1=GET_SOMEWHERE(SELECTOR,ANY_WHERE)
|
||||
OPERAND1=OPERAND(OPND1,N1)
|
||||
OPERAND2=OPERAND(MAKE_FIXED2(I,0),N2)
|
||||
|
||||
CALL EMIT(CASE(NODE_TYPE(SELECTOR))//' '//OPERAND1(:N1)//
|
||||
# ',#0,'//OPERAND2(:N2))
|
||||
|
||||
CALL EMIT_LOCAL_LABEL(LL98)
|
||||
LLL98=LOCAL_LABEL(LL98,L98)
|
||||
|
||||
DO 20 J=0,I
|
||||
|
||||
LLL=LOCAL_LABEL(LL(J),L)
|
||||
CALL EMIT('.SIGNED_WORD '//LLL(:L)//'-'//LLL98(:L98))
|
||||
|
||||
20 CONTINUE
|
||||
|
||||
CALL EMIT_LOCAL_LABEL(LL99)
|
||||
ENDIF
|
||||
|
||||
CALL BREAK
|
||||
CALL END_STATEMENT
|
||||
|
||||
RETURN
|
||||
END
|
||||
424
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/somewhere.for
Normal file
424
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/somewhere.for
Normal file
@@ -0,0 +1,424 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C SOMEWHERE.FOR
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler is the main workhorse for
|
||||
C code generation. It is invoked (recursively) to actually generate
|
||||
C code from a specified code tree, with the resulting value of the
|
||||
C code tree (if any) to be manifested in some desired place ('where').
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 08SEP81 Alex Hunter 1. Temporarily disabled ref_count checking
|
||||
C for atoms. (V5.1)
|
||||
C 2. Fixed bug for procedure call when refct>1.
|
||||
C 15OCT81 Alex Hunter 1. Experimental version. (V5.4)
|
||||
C 23OCT81 Alex Hunter 1. Correct manifestation for OP_LOC. (V5.6)
|
||||
C 2. Improve choice of preferred register.
|
||||
C
|
||||
C***********************************************************************
|
||||
INTEGER*2 FUNCTION GET_SOMEWHERE(NODX,WHEREX)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*80 OPERAND,OPERAND1,OPERAND2
|
||||
C
|
||||
NOD=NODX
|
||||
WHERE=WHEREX
|
||||
|
||||
IF (NOD.EQ.NULL) THEN
|
||||
GET_SOMEWHERE=NULL
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
IF (NODE_REG(NOD).NE.0) THEN
|
||||
REG=NODE_REG(NOD)
|
||||
NODE_TYPE(REG)=NODE_TYPE(NOD)
|
||||
GO TO 100
|
||||
ENDIF
|
||||
|
||||
IF (LITERAL(NOD)) GO TO 50
|
||||
|
||||
IF (CONSTANT(NOD)) GO TO 50
|
||||
|
||||
IF (ATOM(NOD)) THEN
|
||||
CALL PUSH(NOD,1)
|
||||
CALL PUSH(WHERE,1)
|
||||
CALL MAKE_ADDRESSABLE(NOD)
|
||||
CALL POP(WHERE,1)
|
||||
CALL POP(NOD,1)
|
||||
CCCC IF (NODE_REFCT(NOD).GT.1) THEN ! (Temporarily disabled)
|
||||
CCCC REG=ALLOCATE_REG(NODE_TYPE(NOD))
|
||||
CCCC CALL EMIT_CODE(OP_ASSN,NOD,NULL,REG)
|
||||
CCCC NODE_REG(NOD)=REG
|
||||
CCCC NODE_TYPE(REG)=NODE_TYPE(NOD)
|
||||
CCCC GO TO 100
|
||||
CCCC ENDIF
|
||||
GO TO 50
|
||||
ENDIF
|
||||
|
||||
C -- NODE MUST BE AN OPNODE.
|
||||
|
||||
IF (OPNODE_OP(NOD).EQ.OP_MOV) THEN
|
||||
XX=GET_SOMEWHERE2(OPNODE_OPND1(NOD),OPNODE_OPND2(NOD))
|
||||
GET_SOMEWHERE=NULL
|
||||
RETURN
|
||||
|
||||
ELSEIF (OPNODE_OP(NOD).EQ.OP_ASSN) THEN
|
||||
CALL PUSH(WHERE,1)
|
||||
CALL PUSH(NOD,1)
|
||||
IF (WHERE.GE.REG_MIN.AND.WHERE.LE.REG_MAX) THEN
|
||||
REG=GET_SOMEWHERE2(OPNODE_OPND1(NOD),WHERE)
|
||||
ELSE
|
||||
REG=GET_SOMEWHERE2(OPNODE_OPND1(NOD),ANY_REG)
|
||||
ENDIF
|
||||
NODE_TYPE(REG)=NODE_TYPE(NOD)
|
||||
CALL POP(NOD,1)
|
||||
CALL PUSH(NOD,1)
|
||||
CALL PUSH(REG,1)
|
||||
CALL MAKE_ADDRESSABLE(OPNODE_OPND2(NOD))
|
||||
CALL POP(REG,1)
|
||||
CALL POP(NOD,1)
|
||||
CALL POP(WHERE,1)
|
||||
CALL EMIT_CODE(OP_ASSN,REG,NULL,OPNODE_OPND2(NOD))
|
||||
CALL DECREMENT_REFERENCE_COUNTS(ATOM_BASE(OPNODE_OPND2(NOD)))
|
||||
CALL DECREMENT_REFERENCE_COUNTS(ATOM_SUB(OPNODE_OPND2(NOD)))
|
||||
GO TO 100
|
||||
|
||||
ELSEIF (OPNODE_OP(NOD).EQ.OP_CALL) THEN
|
||||
CALL PUSH(WHERE,1)
|
||||
CALL PUSH(NOD,1)
|
||||
NARGS=GET_SOMEWHERE2(OPNODE_OPND2(NOD),ON_STACK)
|
||||
CALL POP(NOD,1)
|
||||
|
||||
CALL PUSH(NOD,1)
|
||||
CALL PUSH(NARGS,1)
|
||||
LOC1=GET_SOMEWHERE2(OPNODE_OPND1(NOD),ANY_WHERE)
|
||||
CALL POP(NARGS,1)
|
||||
CALL POP(NOD,1)
|
||||
CALL POP(WHERE,1)
|
||||
|
||||
OPERAND2=OPERAND(LOC1,N2)
|
||||
|
||||
IF (OPERAND2(1:1).EQ.'(') THEN ! Indirect Call.
|
||||
OPERAND2='L^V.'//OPERAND2
|
||||
N2=N2+4
|
||||
ENDIF
|
||||
|
||||
IF (MODEL.EQ.2 .OR. MODEL.EQ.4) THEN
|
||||
OPND1=MAKE_FIXED2(NARGS,S_LONG)
|
||||
OPERAND1=OPERAND(OPND1,N1)
|
||||
CALL EMIT('CALLS '//OPERAND1(:N1)//','//
|
||||
# OPERAND2(:N2))
|
||||
ELSEIF (NARGS.EQ.0) THEN
|
||||
CALL EMIT('CALLS #0,'//OPERAND2(:N2))
|
||||
ELSE
|
||||
CALL EMIT_CODE(OP_B2L,MAKE_FIXED2(NARGS,S_BYTE),NULL,
|
||||
# ON_STACK)
|
||||
CALL EMIT('CALLG (R10),'//OPERAND2(:N2))
|
||||
CALL EMIT_CODE(OP_ADD,MAKE_FIXED2((NARGS+1)*4,S_LONG),NULL,
|
||||
# 10)
|
||||
ENDIF
|
||||
|
||||
NODE_TYPE(R0)=NODE_TYPE(NOD)
|
||||
|
||||
IF (WHERE.EQ.ANY_WHERE .OR. WHERE.EQ.ANY_REG .OR.
|
||||
# NODE_REFCT(NOD).GT.1) THEN
|
||||
|
||||
REG=ALLOCATE_REG(NODE_TYPE(NOD))
|
||||
CALL EMIT_CODE(OP_ASSN,R0,NULL,REG)
|
||||
NODE_REG(NOD)=REG
|
||||
NODE_TYPE(REG)=NODE_TYPE(NOD)
|
||||
GO TO 100
|
||||
|
||||
ELSEIF (WHERE.EQ.ON_STACK) THEN
|
||||
CALL EMIT_CODE(OP_ASSN,R0,NULL,ON_STACK)
|
||||
CALL DECREMENT_VALUE_COUNTS(NOD)
|
||||
GET_SOMEWHERE=ON_STACK
|
||||
RETURN
|
||||
|
||||
ELSEIF (WHERE.GE.REG_MIN .AND. WHERE.LE.REG_MAX) THEN
|
||||
IF (WHERE.NE.R0) THEN
|
||||
CALL EMIT_CODE(OP_ASSN,R0,NULL,WHERE)
|
||||
CALL DECREMENT_VALUE_COUNTS(NOD)
|
||||
ENDIF
|
||||
GET_SOMEWHERE=WHERE
|
||||
RETURN
|
||||
|
||||
ELSE ! (WHERE IS ATOM)
|
||||
IF (ATOM_SUB(WHERE).EQ.NULL.AND.ATOM_BASE(WHERE).EQ.NULL)
|
||||
# THEN
|
||||
CALL EMIT_CODE(OP_ASSN,R0,NULL,WHERE)
|
||||
CALL DECREMENT_VALUE_COUNTS(NOD)
|
||||
GET_SOMEWHERE=WHERE
|
||||
RETURN
|
||||
ENDIF
|
||||
REG=ALLOCATE_REG(NODE_TYPE(NOD))
|
||||
CALL EMIT_CODE(OP_ASSN,R0,NULL,REG)
|
||||
NODE_REG(NOD)=REG
|
||||
NODE_TYPE(REG)=NODE_TYPE(NOD)
|
||||
GO TO 150
|
||||
ENDIF
|
||||
|
||||
ELSEIF (OPNODE_OP(NOD).EQ.OP_ARG) THEN
|
||||
CALL PUSH(WHERE,1)
|
||||
CALL PUSH(NOD,1)
|
||||
XX=GET_SOMEWHERE2(OPNODE_OPND2(NOD),ON_STACK)
|
||||
CALL POP(NOD,1)
|
||||
CALL PUSH(NOD,1)
|
||||
NARGS=GET_SOMEWHERE2(OPNODE_OPND1(NOD),ON_STACK)
|
||||
CALL POP(NOD,1)
|
||||
CALL POP(WHERE,1)
|
||||
GET_SOMEWHERE=NARGS+1
|
||||
RETURN
|
||||
|
||||
ELSEIF ((OPNODE_OP(NOD).EQ.OP_ADWC.OR.OPNODE_OP(NOD).EQ.OP_SBWC)
|
||||
# .AND.OPNODE_OPND1(NOD).NE.WHERE) THEN
|
||||
CALL PUSH(WHERE,1)
|
||||
CALL PUSH(NOD,1)
|
||||
REG=GET_SOMEWHERE2(OPNODE_OPND1(NOD),ANY_REG)
|
||||
CALL POP(NOD,1)
|
||||
CALL PUSH(NOD,1)
|
||||
CALL PUSH(REG,1)
|
||||
LOC2=GET_SOMEWHERE2(OPNODE_OPND2(NOD),ANY_WHERE)
|
||||
CALL POP(REG,1)
|
||||
CALL POP(NOD,1)
|
||||
CALL POP(WHERE,1)
|
||||
NODE_REG(OPNODE_OPND1(NOD))=0
|
||||
CALL EMIT_CODE(OPNODE_OP(NOD),LOC2,REG,REG)
|
||||
NODE_REG(NOD)=REG
|
||||
NODE_TYPE(REG)=NODE_TYPE(NOD)
|
||||
GO TO 100
|
||||
ENDIF
|
||||
|
||||
IF (OPNODE_OP(NOD).EQ.OP_LOC) THEN
|
||||
LOC1=OPNODE_OPND1(NOD)
|
||||
LOC2=OPNODE_OPND2(NOD)
|
||||
CALL PUSH(WHERE,1)
|
||||
CALL PUSH(NOD,1)
|
||||
CALL PUSH(LOC1,1)
|
||||
CALL PUSH(LOC2,1)
|
||||
CALL MAKE_ADDRESSABLE(LOC1)
|
||||
CALL POP(LOC2,1)
|
||||
CALL PUSH(LOC2,1)
|
||||
CALL MAKE_ADDRESSABLE(LOC2)
|
||||
CALL POP(LOC2,1)
|
||||
CALL POP(LOC1,1)
|
||||
CALL POP(NOD,1)
|
||||
CALL POP(WHERE,1)
|
||||
ELSE
|
||||
CALL PUSH(WHERE,1)
|
||||
CALL PUSH(NOD,1)
|
||||
LOC1=GET_SOMEWHERE2(OPNODE_OPND1(NOD),ANY_WHERE)
|
||||
CALL POP(NOD,1)
|
||||
CALL PUSH(NOD,1)
|
||||
CALL PUSH(LOC1,1)
|
||||
LOC2=GET_SOMEWHERE2(OPNODE_OPND2(NOD),ANY_WHERE)
|
||||
CALL POP(LOC1,1)
|
||||
CALL POP(NOD,1)
|
||||
CALL POP(WHERE,1)
|
||||
ENDIF
|
||||
|
||||
IF (OPNODE_OP(NOD).EQ.OP_THEN.OR.OPNODE_OP(NOD).EQ.OP_ALSO) THEN
|
||||
GET_SOMEWHERE=NULL
|
||||
RETURN
|
||||
|
||||
ELSEIF (WHERE.EQ.ANY_WHERE .OR. WHERE.EQ.ANY_REG .OR.
|
||||
# NODE_REFCT(NOD).GT.1) THEN
|
||||
|
||||
IF (OPNODE_OP(NOD).EQ.OP_LOC) THEN
|
||||
IF (ATOM(LOC1)) THEN
|
||||
CALL DECREMENT_REFERENCE_COUNTS(ATOM_BASE(LOC1))
|
||||
CALL DECREMENT_REFERENCE_COUNTS(ATOM_SUB(LOC1))
|
||||
ENDIF
|
||||
ELSE
|
||||
CALL DECREMENT_VALUE_COUNTS(OPNODE_OPND1(NOD))
|
||||
CALL DECREMENT_VALUE_COUNTS(OPNODE_OPND2(NOD))
|
||||
ENDIF
|
||||
IF (REGISTER(LOC1)) THEN
|
||||
PREFERRED_REG=LOC1
|
||||
ELSE
|
||||
PREFERRED_REG=LOC2
|
||||
ENDIF
|
||||
REG=ALLOCATE_REG_WITH_PREFERENCE(NODE_TYPE(NOD),PREFERRED_REG)
|
||||
CALL EMIT_CODE(OPNODE_OP(NOD),LOC2,LOC1,REG)
|
||||
NODE_REG(NOD)=REG
|
||||
NODE_TYPE(REG)=NODE_TYPE(NOD)
|
||||
GO TO 100
|
||||
|
||||
ELSEIF (WHERE.EQ.ON_STACK) THEN
|
||||
CALL EMIT_CODE(OPNODE_OP(NOD),LOC2,LOC1,ON_STACK)
|
||||
IF (OPNODE_OP(NOD).EQ.OP_LOC) THEN
|
||||
IF (ATOM(LOC1)) THEN
|
||||
CALL DECREMENT_REFERENCE_COUNTS(ATOM_BASE(LOC1))
|
||||
CALL DECREMENT_REFERENCE_COUNTS(ATOM_SUB(LOC1))
|
||||
ENDIF
|
||||
ELSE
|
||||
CALL DECREMENT_VALUE_COUNTS(OPNODE_OPND1(NOD))
|
||||
CALL DECREMENT_VALUE_COUNTS(OPNODE_OPND2(NOD))
|
||||
ENDIF
|
||||
CALL DECREMENT_REFERENCE_COUNTS(NOD)
|
||||
GET_SOMEWHERE=ON_STACK
|
||||
RETURN
|
||||
|
||||
ELSEIF (WHERE.GE.REG_MIN.AND.WHERE.LE.REG_MAX) THEN
|
||||
CALL EMIT_CODE(OPNODE_OP(NOD),LOC2,LOC1,WHERE)
|
||||
IF (OPNODE_OP(NOD).EQ.OP_LOC) THEN
|
||||
IF (ATOM(LOC1)) THEN
|
||||
CALL DECREMENT_REFERENCE_COUNTS(ATOM_BASE(LOC1))
|
||||
CALL DECREMENT_REFERENCE_COUNTS(ATOM_SUB(LOC1))
|
||||
ENDIF
|
||||
ELSE
|
||||
CALL DECREMENT_VALUE_COUNTS(OPNODE_OPND1(NOD))
|
||||
CALL DECREMENT_VALUE_COUNTS(OPNODE_OPND2(NOD))
|
||||
ENDIF
|
||||
NODE_REG(NOD)=WHERE
|
||||
GET_SOMEWHERE=WHERE
|
||||
RETURN
|
||||
|
||||
ELSE ! (WHERE IS ATOM)
|
||||
|
||||
CALL PUSH(WHERE,1)
|
||||
CALL PUSH(NOD,1)
|
||||
CALL PUSH(LOC1,1)
|
||||
CALL PUSH(LOC2,1)
|
||||
CALL MAKE_ADDRESSABLE(WHERE)
|
||||
CALL POP(LOC2,1)
|
||||
CALL POP(LOC1,1)
|
||||
CALL POP(NOD,1)
|
||||
CALL POP(WHERE,1)
|
||||
CALL EMIT_CODE(OPNODE_OP(NOD),LOC2,LOC1,WHERE)
|
||||
IF (OPNODE_OP(NOD).EQ.OP_LOC) THEN
|
||||
IF (ATOM(LOC1)) THEN
|
||||
CALL DECREMENT_REFERENCE_COUNTS(ATOM_BASE(LOC1))
|
||||
CALL DECREMENT_REFERENCE_COUNTS(ATOM_SUB(LOC1))
|
||||
ENDIF
|
||||
ELSE
|
||||
CALL DECREMENT_VALUE_COUNTS(OPNODE_OPND1(NOD))
|
||||
CALL DECREMENT_VALUE_COUNTS(OPNODE_OPND2(NOD))
|
||||
ENDIF
|
||||
CALL DECREMENT_REFERENCE_COUNTS(NOD)
|
||||
CALL DECREMENT_REFERENCE_COUNTS(ATOM_BASE(WHERE))
|
||||
CALL DECREMENT_REFERENCE_COUNTS(ATOM_SUB(WHERE))
|
||||
GET_SOMEWHERE=WHERE
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
C --- NODE IS ATOM OR LITERAL.
|
||||
|
||||
50 IF (WHERE.EQ.ANY_WHERE) THEN
|
||||
GET_SOMEWHERE=NOD
|
||||
RETURN
|
||||
|
||||
ELSEIF (WHERE.EQ.ANY_REG) THEN
|
||||
REG=ALLOCATE_REG(NODE_TYPE(NOD))
|
||||
CALL EMIT_CODE(OP_ASSN,NOD,NULL,REG)
|
||||
NODE_REG(NOD)=REG
|
||||
GET_SOMEWHERE=REG
|
||||
RETURN
|
||||
|
||||
ELSEIF (WHERE.EQ.ON_STACK) THEN
|
||||
CALL EMIT_CODE(OP_ASSN,NOD,NULL,ON_STACK)
|
||||
CALL DECREMENT_VALUE_COUNTS(NOD)
|
||||
GET_SOMEWHERE=ON_STACK
|
||||
RETURN
|
||||
|
||||
ELSEIF (WHERE.GE.REG_MIN.AND.WHERE.LE.REG_MAX) THEN
|
||||
CALL EMIT_CODE(OP_ASSN,NOD,NULL,WHERE)
|
||||
NODE_REG(NOD)=WHERE
|
||||
GET_SOMEWHERE=WHERE
|
||||
RETURN
|
||||
|
||||
ELSE ! (WHERE IS ATOM)
|
||||
|
||||
CALL PUSH(WHERE,1)
|
||||
CALL PUSH(NOD,1)
|
||||
CALL MAKE_ADDRESSABLE(WHERE)
|
||||
CALL POP(NOD,1)
|
||||
CALL POP(WHERE,1)
|
||||
CALL EMIT_CODE(OP_ASSN,NOD,NULL,WHERE)
|
||||
CALL DECREMENT_VALUE_COUNTS(NOD)
|
||||
CALL DECREMENT_REFERENCE_COUNTS(ATOM_BASE(WHERE))
|
||||
CALL DECREMENT_REFERENCE_COUNTS(ATOM_SUB(WHERE))
|
||||
GET_SOMEWHERE=WHERE
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
C --- VALUE OF NODE IS ALREADY IN REGISTER.
|
||||
|
||||
100 IF (WHERE.EQ.ANY_WHERE .OR. WHERE.EQ.ANY_REG .OR.
|
||||
# WHERE.EQ.REG) THEN
|
||||
GET_SOMEWHERE=REG
|
||||
RETURN
|
||||
|
||||
ELSEIF(WHERE.EQ.ON_STACK) THEN
|
||||
CALL EMIT_CODE(OP_ASSN,REG,NULL,ON_STACK)
|
||||
CALL DECREMENT_VALUE_COUNTS(NOD)
|
||||
GET_SOMEWHERE=ON_STACK
|
||||
RETURN
|
||||
|
||||
ELSEIF (WHERE.GE.REG_MIN.AND.WHERE.LE.REG_MAX) THEN
|
||||
CALL EMIT_CODE(OP_ASSN,REG,NULL,WHERE)
|
||||
CALL DECREMENT_VALUE_COUNTS(NOD) ! ???
|
||||
GET_SOMEWHERE=WHERE
|
||||
RETURN
|
||||
|
||||
ELSE ! (WHERE IS ATOM)
|
||||
|
||||
150 CALL PUSH(WHERE,1)
|
||||
CALL PUSH(NOD,1)
|
||||
CALL PUSH(REG,1)
|
||||
CALL MAKE_ADDRESSABLE(WHERE)
|
||||
CALL POP(REG,1)
|
||||
CALL POP(NOD,1)
|
||||
CALL POP(WHERE,1)
|
||||
CALL EMIT_CODE(OP_ASSN,REG,NULL,WHERE)
|
||||
CALL DECREMENT_VALUE_COUNTS(NOD)
|
||||
CALL DECREMENT_REFERENCE_COUNTS(ATOM_BASE(WHERE))
|
||||
CALL DECREMENT_REFERENCE_COUNTS(ATOM_SUB(WHERE))
|
||||
GET_SOMEWHERE=WHERE
|
||||
RETURN
|
||||
ENDIF
|
||||
END
|
||||
C--------------------------------------------------------------
|
||||
INTEGER*2 FUNCTION GET_SOMEWHERE2(NODX,WHEREX)
|
||||
IMPLICIT INTEGER*2 (A-Z)
|
||||
GET_SOMEWHERE2=GET_SOMEWHERE(NODX,WHEREX)
|
||||
RETURN
|
||||
END
|
||||
C--------------------------------------------------------------
|
||||
SUBROUTINE MAKE_ADDRESSABLE(ATMX)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
|
||||
ATM=ATMX
|
||||
IF (ATOM(ATM)) THEN
|
||||
CALL PUSH(ATM,1)
|
||||
BASEREG=GET_SOMEWHERE(ATOM_BASE(ATM),ANY_REG)
|
||||
CALL POP(ATM,1)
|
||||
XREG=GET_SOMEWHERE(ATOM_SUB(ATM),ANY_REG)
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
155
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/strings.for
Normal file
155
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/strings.for
Normal file
@@ -0,0 +1,155 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C STRINGS.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler contains several character
|
||||
C string utility functions.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 18OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 2. Re-coded LNB.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*4 FUNCTION LNB(STRING)
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Function to locate the last non-blank character of a character
|
||||
C string.
|
||||
C
|
||||
C Return with LNB = index of last non-blank character in STRING
|
||||
C (or LNB = 1 if STRING contains only blanks).
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
IMPLICIT INTEGER*4 (A-Z)
|
||||
CHARACTER*(*) STRING
|
||||
|
||||
LNB = LEN(STRING)
|
||||
DO WHILE (LNB.GT.1 .AND. STRING(LNB:LNB).EQ.' ')
|
||||
LNB = LNB - 1
|
||||
ENDDO
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Function to convert a signed integer*4 value into an ASCII
|
||||
C character*10 string representation.
|
||||
C
|
||||
C The character string will be right-justified with leading blanks.
|
||||
C The index of the first significant (i.e., non-blank) character
|
||||
C in the string will be returned in IFSD.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
CHARACTER*10 FUNCTION STRING10 (N, IFSD)
|
||||
IMPLICIT INTEGER*4 (A-Z)
|
||||
|
||||
IF (N.EQ.'80000000'X) THEN
|
||||
STRING10 = '2147483648'
|
||||
IFSD = 1
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
STRING10 = ' '
|
||||
M = ABS(N)
|
||||
I = 11
|
||||
100 I = I - 1
|
||||
STRING10(I:I) = CHAR(ICHAR('0')+MOD(M,10))
|
||||
M = M/10
|
||||
IF (M.NE.0) GO TO 100
|
||||
IF (N.LT.0) THEN
|
||||
I = I - 1
|
||||
STRING10(I:I) = '-'
|
||||
ENDIF
|
||||
IFSD = I
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Function to convert a REAL*4 value into an ASCII character*14
|
||||
C string representation.
|
||||
C
|
||||
C The index of the first significant character in the string will be
|
||||
C returned in IFSD, and the index of the last significant character
|
||||
C will be returned in ILSD.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
CHARACTER*14 FUNCTION STRINGG(RVAL,IFSD,ILSD)
|
||||
INTEGER*4 IFSD, ILSD
|
||||
REAL*4 RVAL
|
||||
|
||||
ENCODE(14,1000,STRINGG) RVAL
|
||||
1000 FORMAT(G14.7)
|
||||
|
||||
IF (STRINGG.EQ.' 0.0000000E+00') THEN
|
||||
IFSD=2
|
||||
ILSD=4
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
DO 10 IFSD=1,13
|
||||
IF (STRINGG(IFSD:IFSD).NE.' ') GO TO 20
|
||||
10 CONTINUE
|
||||
|
||||
20 IF (STRINGG(11:11).EQ.'E') THEN
|
||||
ILSD=14
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
DO 30 ILSD=14,2,-1
|
||||
IF (STRINGG(ILSD:ILSD).NE.' '.AND.STRINGG(ILSD:ILSD).NE.'0')
|
||||
# GO TO 40
|
||||
30 CONTINUE
|
||||
|
||||
40 IF (STRINGG(ILSD:ILSD+1).EQ.'.0') ILSD=ILSD+1
|
||||
RETURN
|
||||
END
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C Function to convert a UDI-style byte string into a FORTRAN character
|
||||
C string.
|
||||
C
|
||||
C The byte string in STRING is copied into the character string CHARS
|
||||
C and the length of the string is returned as the value of the
|
||||
C function.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER*4 FUNCTION MAKE_CHARS(CHARS,STRING)
|
||||
CHARACTER*(*) CHARS
|
||||
BYTE STRING(0:0)
|
||||
|
||||
IF (STRING(0).GT.0) THEN
|
||||
DO 10 I=1,STRING(0)
|
||||
CHARS(I:I)=CHAR(STRING(I))
|
||||
10 CONTINUE
|
||||
MAKE_CHARS=STRING(0)
|
||||
ELSE
|
||||
CHARS=' '
|
||||
MAKE_CHARS=1
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
332
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/summary.for
Normal file
332
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/summary.for
Normal file
@@ -0,0 +1,332 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C SUMMARY.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler is used to produce the
|
||||
C summaries at the beginning and end of a compilation listing.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 20OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 09NOV81 Alex Hunter 1. Print assumptions in summary tail. (V5.8)
|
||||
C 10NOV81 Alex Hunter 1. Add DBG assumption. (V6.0)
|
||||
C 14JAN82 Alex Hunter 1. Change "S32" to "S64". (V6.5)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE SUMMARY_HEAD
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*256 TAIL
|
||||
COMMON /COMMAND_TAIL/ TAIL
|
||||
CHARACTER*1 CR
|
||||
DATA CR /'0D'X/
|
||||
CHARACTER*132 LINE
|
||||
CHARACTER*10 STRING10,S1
|
||||
INTEGER*4 IFSD,IVAL
|
||||
LOGICAL*1 ASSUMPTIONS(15)
|
||||
EQUIVALENCE (ASSUMPTIONS,ASSUME_SCE)
|
||||
CHARACTER*3 ASSUMPTION_NAME(15)
|
||||
DATA ASSUMPTION_NAME /
|
||||
# 'SCE','CSE','EEQ','PSE','BRO','BBA','CTE',
|
||||
# 'MCO','CFA','SWB','OSR','SVE','S64','C7F','DBG'/
|
||||
|
||||
ENCODE(132,1001,LINE) VERSION,
|
||||
# (IN_FILE_STRING(I,8),I=1,IN_FILE_STRING(0,8))
|
||||
1001 FORMAT('PL/M-VAX V',F3.1,' Compilation of ',45A1)
|
||||
CALL LIST_LINE(LINE)
|
||||
|
||||
IF (GLOBALS_FLAG) THEN
|
||||
ENCODE(132,1008,LINE)
|
||||
# (GLOBALS_FILE_STRING(I),I=1,GLOBALS_FILE_STRING(0))
|
||||
1008 FORMAT('Global Symbols read from ',45A1)
|
||||
CALL LIST_LINE(LINE)
|
||||
ENDIF
|
||||
|
||||
IF (PRINT_FLAG) THEN
|
||||
ENCODE(132,1006,LINE)
|
||||
# (PRINT_FILE_STRING(I),I=1,PRINT_FILE_STRING(0))
|
||||
1006 FORMAT('Source Listing written to ',45A1)
|
||||
CALL LIST_LINE(LINE)
|
||||
ENDIF
|
||||
|
||||
IF (OBJECT_FLAG) THEN
|
||||
ENCODE(132,1002,LINE)
|
||||
# (WORK_FILE_STRING(I),I=1,WORK_FILE_STRING(0))
|
||||
1002 FORMAT('Intermediate Code placed in ',45A1)
|
||||
CALL LIST_LINE(LINE)
|
||||
ENDIF
|
||||
|
||||
IF (PUBLICS_FLAG) THEN
|
||||
ENCODE(132,1009,LINE)
|
||||
# (PUBLICS_FILE_STRING(I),I=1,PUBLICS_FILE_STRING(0))
|
||||
1009 FORMAT('Public Symbols placed in ',45A1)
|
||||
CALL LIST_LINE(LINE)
|
||||
ENDIF
|
||||
|
||||
IF (IXREF_FLAG) THEN
|
||||
ENCODE(132,1003,LINE)
|
||||
# (IXREF_FILE_STRING(I),I=1,IXREF_FILE_STRING(0))
|
||||
1003 FORMAT('Intermodule XREF placed in ',45A1)
|
||||
CALL LIST_LINE(LINE)
|
||||
ENDIF
|
||||
|
||||
IF (OBJECT_FLAG) THEN
|
||||
ENCODE(132,1004,LINE)
|
||||
# (OBJECT_FILE_STRING(I),I=1,OBJECT_FILE_STRING(0))
|
||||
1004 FORMAT('Object Module placed in ',45A1)
|
||||
CALL LIST_LINE(LINE)
|
||||
ENDIF
|
||||
|
||||
IF (OPRINT_FLAG.AND.OBJECT_FLAG) THEN
|
||||
ENCODE(132,1007,LINE)
|
||||
# (OPRINT_FILE_STRING(I),I=1,OPRINT_FILE_STRING(0))
|
||||
1007 FORMAT('Object Listing placed in ',45A1)
|
||||
CALL LIST_LINE(LINE)
|
||||
ENDIF
|
||||
|
||||
DO 10 I=1,100
|
||||
IF (TAIL(I:I).EQ.CR) GO TO 20
|
||||
10 CONTINUE
|
||||
I=101
|
||||
20 I=I-1
|
||||
ENCODE(132,1005,LINE) TAIL(1:I)
|
||||
1005 FORMAT('Compiler invoked by: PLM ',A)
|
||||
CALL LIST_LINE(LINE)
|
||||
|
||||
CALL LIST_LINE(' ')
|
||||
CALL LIST_LINE(' ')
|
||||
CALL LIST_LINE(' ')
|
||||
|
||||
RETURN
|
||||
C------------------------------------------
|
||||
ENTRY SUMMARY_TAIL
|
||||
C------------------------------------------
|
||||
CALL ROOM_FOR(15)
|
||||
CALL LIST_LINE(' ')
|
||||
CALL LIST_LINE(' ')
|
||||
|
||||
CALL LIST_LINE('Compilation Summary:')
|
||||
CALL LIST_LINE(' ')
|
||||
|
||||
ENCODE(132,1011,LINE) OPTIMIZE,PAGELENGTH,PAGEWIDTH,TABS
|
||||
1011 FORMAT('Primary Controls:',T20,'OPTIMIZE(',I1,') PAGELENGTH(',
|
||||
# I3,') PAGEWIDTH(',I3,') TABS(',I2,')')
|
||||
CALL LIST_LINE(LINE)
|
||||
|
||||
LINE=' '
|
||||
N=20
|
||||
|
||||
IF (MODEL.EQ.1) LINE(N:)='SMALL'
|
||||
IF (MODEL.EQ.2) LINE(N:)='COMPACT'
|
||||
IF (MODEL.EQ.3) LINE(N:)='MEDIUM'
|
||||
IF (MODEL.EQ.4) LINE(N:)='LARGE'
|
||||
N=LNB(LINE)+2
|
||||
|
||||
IF (PRINT_FLAG) THEN
|
||||
LINE(N:)='PRINT'
|
||||
ELSE
|
||||
LINE(N:)='NOPRINT'
|
||||
ENDIF
|
||||
N=LNB(LINE)+2
|
||||
|
||||
IF (XREF_FLAG) THEN
|
||||
LINE(N:)='XREF'
|
||||
ELSE
|
||||
LINE(N:)='NOXREF'
|
||||
ENDIF
|
||||
N=LNB(LINE)+2
|
||||
|
||||
IF (IXREF_FLAG) THEN
|
||||
LINE(N:)='IXREF'
|
||||
ELSE
|
||||
LINE(N:)='NOIXREF'
|
||||
ENDIF
|
||||
N=LNB(LINE)+2
|
||||
|
||||
IF (OBJECT_FLAG) THEN
|
||||
LINE(N:)='OBJECT'
|
||||
ELSE
|
||||
LINE(N:)='NOOBJECT'
|
||||
ENDIF
|
||||
N=LNB(LINE)+2
|
||||
|
||||
IF (OPRINT_FLAG) THEN
|
||||
LINE(N:)='OPRINT'
|
||||
ELSE
|
||||
LINE(N:)='NOOPRINT'
|
||||
ENDIF
|
||||
N=LNB(LINE)+2
|
||||
|
||||
IF (SYMBOLS_FLAG) THEN
|
||||
LINE(N:)='SYMBOLS'
|
||||
ELSE
|
||||
LINE(N:)='NOSYMBOLS'
|
||||
ENDIF
|
||||
N=LNB(LINE)+2
|
||||
|
||||
IF (DEBUG_FLAG) THEN
|
||||
LINE(N:)='DEBUG'
|
||||
ELSE
|
||||
LINE(N:)='NODEBUG'
|
||||
ENDIF
|
||||
N=LNB(LINE)+2
|
||||
|
||||
IF (PAGING_FLAG) THEN
|
||||
LINE(N:)='PAGING'
|
||||
ELSE
|
||||
LINE(N:)='NOPAGING'
|
||||
ENDIF
|
||||
N=LNB(LINE)+2
|
||||
|
||||
IF (INTVECTOR_FLAG) THEN
|
||||
LINE(N:)='INTVECTOR'
|
||||
ELSE
|
||||
LINE(N:)='NOINTVECTOR'
|
||||
ENDIF
|
||||
N=LNB(LINE)+2
|
||||
|
||||
CALL LIST_LINE(LINE)
|
||||
|
||||
LINE=' '
|
||||
N=20
|
||||
|
||||
IF (TYPE_FLAG) THEN
|
||||
LINE(N:)='TYPE'
|
||||
ELSE
|
||||
LINE(N:)='NOTYPE'
|
||||
ENDIF
|
||||
N=LNB(LINE)+2
|
||||
|
||||
IF (ROM_FLAG) THEN
|
||||
LINE(N:)='ROM'
|
||||
ELSE
|
||||
LINE(N:)='RAM'
|
||||
ENDIF
|
||||
N=LNB(LINE)+2
|
||||
|
||||
IF (WARN_FLAG) THEN
|
||||
LINE(N:)='WARN'
|
||||
ELSE
|
||||
LINE(N:)='NOWARN'
|
||||
ENDIF
|
||||
N=LNB(LINE)+2
|
||||
|
||||
IF (PLM80_FLAG) THEN
|
||||
LINE(N:)='PLM80'
|
||||
N=LNB(LINE)+2
|
||||
ENDIF
|
||||
|
||||
IF (GLOBALS_FLAG) THEN
|
||||
LINE(N:)='GLOBALS'
|
||||
ELSE
|
||||
LINE(N:)='NOGLOBALS'
|
||||
ENDIF
|
||||
N=LNB(LINE)+2
|
||||
|
||||
IF (PUBLICS_FLAG) THEN
|
||||
LINE(N:)='PUBLICS'
|
||||
ELSE
|
||||
LINE(N:)='NOPUBLICS'
|
||||
ENDIF
|
||||
N=LNB(LINE)+2
|
||||
|
||||
IF (OVERLAY_FLAG) THEN
|
||||
LINE(N:)='OVERLAY'
|
||||
ELSE
|
||||
LINE(N:)='NOOVERLAY'
|
||||
ENDIF
|
||||
N=LNB(LINE)+2
|
||||
|
||||
IF (ROOT_FLAG) THEN
|
||||
LINE(N:)='ROOT'
|
||||
ELSE
|
||||
LINE(N:)='NOROOT'
|
||||
ENDIF
|
||||
N=LNB(LINE)+2
|
||||
|
||||
IF (ALIGN_FLAG) THEN
|
||||
LINE(N:)='ALIGN'
|
||||
ELSE
|
||||
LINE(N:)='NOALIGN'
|
||||
ENDIF
|
||||
N=LNB(LINE)+2
|
||||
|
||||
IF (FREQ_FLAG) THEN
|
||||
LINE(N:)='FREQUENCIES'
|
||||
N=LNB(LINE)+2
|
||||
ENDIF
|
||||
|
||||
IF (VECTOR_FLAG) THEN
|
||||
LINE(N:)='VECTOR'
|
||||
ELSE
|
||||
LINE(N:)='NOVECTOR'
|
||||
ENDIF
|
||||
N=LNB(LINE)+2
|
||||
|
||||
CALL LIST_LINE(LINE)
|
||||
CALL LIST_LINE(' ')
|
||||
|
||||
LINE='Assumptions:'
|
||||
N=20
|
||||
|
||||
DO I=1,15
|
||||
IF (.NOT.ASSUMPTIONS(I)) THEN
|
||||
LINE(N:)='NO'
|
||||
N=N+2
|
||||
ENDIF
|
||||
LINE(N:)=ASSUMPTION_NAME(I)
|
||||
N=N+4
|
||||
ENDDO
|
||||
|
||||
CALL LIST_LINE(LINE)
|
||||
CALL LIST_LINE(' ')
|
||||
|
||||
IVAL=LINES_READ
|
||||
S1=STRING10(IVAL,IFSD)
|
||||
ENCODE(132,1012,LINE) S1(IFSD:)
|
||||
1012 FORMAT(T20,A,' Lines Read')
|
||||
CALL LIST_LINE(LINE)
|
||||
|
||||
IVAL=ERRORS
|
||||
S1=STRING10(IVAL,IFSD)
|
||||
ENCODE(132,1013,LINE) S1(IFSD:)
|
||||
1013 FORMAT(T20,A,' Program Error(s)')
|
||||
CALL LIST_LINE(LINE)
|
||||
|
||||
IF (WARNINGS.NE.0) THEN
|
||||
IVAL=WARNINGS
|
||||
S1=STRING10(IVAL,IFSD)
|
||||
ENCODE(132,1014,LINE) S1(IFSD:)
|
||||
1014 FORMAT(T20,A,' Program Warning(s)')
|
||||
CALL LIST_LINE(LINE)
|
||||
ENDIF
|
||||
|
||||
CALL LIST_LINE(' ')
|
||||
CALL LIST_LINE('End of PL/M-VAX Compilation')
|
||||
|
||||
RETURN
|
||||
END
|
||||
134
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/symtab.for
Normal file
134
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/symtab.for
Normal file
@@ -0,0 +1,134 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C SYMTAB.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler contains procedures to enter
|
||||
C and lookup identifiers in the symbol and member-symbol tables.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 29SEP81 Alex Hunter 1. Re-compiled with larger symbol table.
|
||||
C 21OCT81 Alex Hunter 1. Initialize serial no. fields. (V5.5)
|
||||
C 12NOV81 Alex Hunter 1. Initialize psect field. (V6.1)
|
||||
C
|
||||
C***********************************************************************
|
||||
SUBROUTINE ENTER_SYMBOL
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*32 UNIQUE
|
||||
C
|
||||
H=HASH(IDENTIFIER)
|
||||
I=HASH_BUCKET(H)
|
||||
10 IF (I.GE.SYMBOL_TOP(BLOCK_LEVEL-1)+1) THEN
|
||||
IF (SYMBOL_PLM_ID(I).EQ.IDENTIFIER) THEN
|
||||
IF (SYMBOL_REF(I).EQ.S_ARG.AND.SYMBOL_FLAGS(I).EQ.S_UNDEF
|
||||
# .OR.SYMBOL_REF(I).EQ.S_FORWARD)
|
||||
# THEN
|
||||
SYMBOL_INDEX=I
|
||||
RETURN
|
||||
ENDIF
|
||||
CALL ERROR('DUPLICATE DECLARATION FOR '//IDENTIFIER)
|
||||
GO TO 20
|
||||
ENDIF
|
||||
I=SYMBOL_CHAIN(I)
|
||||
GO TO 10
|
||||
ENDIF
|
||||
20 SYMBOL_INDEX=SYMBOL_TOP(BLOCK_LEVEL)+1
|
||||
IF (SYMBOL_INDEX.GT.SYMBOL_MAX)
|
||||
# CALL FATAL('SYMBOL TABLE OVERFLOW')
|
||||
SYMBOL_TOP(BLOCK_LEVEL)=SYMBOL_INDEX
|
||||
SYMBOL_PLM_ID(SYMBOL_INDEX)=IDENTIFIER
|
||||
SYMBOL_VAX_ID(SYMBOL_INDEX)=UNIQUE(IDENTIFIER)
|
||||
SYMBOL_KIND(SYMBOL_INDEX)=0
|
||||
SYMBOL_TYPE(SYMBOL_INDEX)=0
|
||||
SYMBOL_NBR_ELEMENTS(SYMBOL_INDEX)=0
|
||||
SYMBOL_ELEMENT_SIZE(SYMBOL_INDEX)=0
|
||||
SYMBOL_LINK(SYMBOL_INDEX)=0
|
||||
SYMBOL_LIST_SIZE(SYMBOL_INDEX)=0
|
||||
SYMBOL_REF(SYMBOL_INDEX)=0
|
||||
SYMBOL_BASE(SYMBOL_INDEX)=0
|
||||
SYMBOL_BASE_MEMBER(SYMBOL_INDEX)=0
|
||||
SYMBOL_FLAGS(SYMBOL_INDEX)=S_UNDEF
|
||||
SYMBOL_DISP(SYMBOL_INDEX)=0
|
||||
SYMBOL_SERIAL_NO(SYMBOL_INDEX)=0
|
||||
SYMBOL_PSECT(SYMBOL_INDEX)=0
|
||||
SYMBOL_CHAIN(SYMBOL_INDEX)=HASH_BUCKET(H)
|
||||
HASH_BUCKET(H)=SYMBOL_INDEX
|
||||
RETURN
|
||||
C-------------------------------
|
||||
ENTRY LOOKUP_SYMBOL
|
||||
H=HASH(IDENTIFIER)
|
||||
SYMBOL_INDEX=HASH_BUCKET(H)
|
||||
30 IF (SYMBOL_INDEX.GT.0) THEN
|
||||
IF (SYMBOL_PLM_ID(SYMBOL_INDEX).EQ.IDENTIFIER) THEN
|
||||
IF ((SYMBOL_FLAGS(SYMBOL_INDEX).AND.S_UNDEF).NE.0) THEN
|
||||
CALL ERROR('NO DECLARATION FOR '//IDENTIFIER)
|
||||
ENDIF
|
||||
RETURN
|
||||
ENDIF
|
||||
SYMBOL_INDEX=SYMBOL_CHAIN(SYMBOL_INDEX)
|
||||
GO TO 30
|
||||
ENDIF
|
||||
CALL ERROR('UNDEFINED SYMBOL: '//IDENTIFIER)
|
||||
GO TO 20
|
||||
END
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE ENTER_MEMBER
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*32 UNIQUE
|
||||
C
|
||||
MEMBER_INDEX=MEMBER_TOP(BLOCK_LEVEL)+1
|
||||
IF (MEMBER_INDEX.GT.MEMBER_MAX)
|
||||
# CALL FATAL('MEMBER TABLE OVERFLOW')
|
||||
MEMBER_TOP(BLOCK_LEVEL)=MEMBER_INDEX
|
||||
MEMBER_PLM_ID(MEMBER_INDEX)=IDENTIFIER
|
||||
MEMBER_VAX_ID(MEMBER_INDEX)=UNIQUE(IDENTIFIER)
|
||||
MEMBER_KIND(MEMBER_INDEX)=0
|
||||
MEMBER_TYPE(MEMBER_INDEX)=0
|
||||
MEMBER_NBR_ELEMENTS(MEMBER_INDEX)=0
|
||||
MEMBER_ELEMENT_SIZE(MEMBER_INDEX)=0
|
||||
MEMBER_SERIAL_NO(MEMBER_INDEX)=0
|
||||
RETURN
|
||||
C-------- CHECK FOR DUPLICATE MEMBER NAMES!!! ------
|
||||
C
|
||||
C-------------------------------
|
||||
ENTRY LOOKUP_MEMBER
|
||||
IF (SYMBOL_TYPE(SYMBOL_INDEX).NE.S_STRUC) THEN
|
||||
CALL ERROR('NOT A STRUCTURE: '//
|
||||
# SYMBOL_PLM_ID(SYMBOL_INDEX))
|
||||
ELSE
|
||||
DO 20 MEMBER_INDEX=SYMBOL_LINK(SYMBOL_INDEX),
|
||||
# SYMBOL_LINK(SYMBOL_INDEX)+
|
||||
# SYMBOL_LIST_SIZE(SYMBOL_INDEX)-1
|
||||
IF (MEMBER_PLM_ID(MEMBER_INDEX).EQ.IDENTIFIER) RETURN
|
||||
20 CONTINUE
|
||||
CALL ERROR('UNDEFINED MEMBER: '//IDENTIFIER)
|
||||
ENDIF
|
||||
MEMBER_INDEX=0
|
||||
RETURN
|
||||
END
|
||||
97
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/unique.for
Normal file
97
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/unique.for
Normal file
@@ -0,0 +1,97 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C UNIQUE.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler contains routines used to
|
||||
C generate unique identifiers for local symbols, public symbols,
|
||||
C and transfer vector entry points.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 20OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 14NOV81 Alex Hunter 1. Use full 31-character external names
|
||||
C (hopefully the bug in MACRO has been
|
||||
C fixed). (V6.2)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
CHARACTER*32 FUNCTION UNIQUE(IDENT)
|
||||
IMPLICIT INTEGER*2 (A-Z)
|
||||
CHARACTER IDENT*(*), STRING10*10, Q*10
|
||||
INTEGER*4 N, IFSD
|
||||
DATA N/0/
|
||||
C
|
||||
N=N+1
|
||||
Q=STRING10(N,IFSD)
|
||||
K=MIN(16,LNB(IDENT))
|
||||
UNIQUE=IDENT(1:K)//'.'//Q(IFSD:10)
|
||||
RETURN
|
||||
END
|
||||
C------------------------------------------------
|
||||
CHARACTER*32 FUNCTION PUBLIQUE(IDENT)
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*32 IDENT
|
||||
CHARACTER*3 BAD_ID(20)
|
||||
CHARACTER*4 GOOD_ID(20)
|
||||
DATA BAD_ID
|
||||
//'R0','R1','R2','R3','R4','R5','R6','R7','R8','R9','R10'
|
||||
,,'R11','R12','R13','R14','R15','AP','FP','SP','PC'
|
||||
//
|
||||
DATA GOOD_ID
|
||||
//'R0.','R1.','R2.','R3.','R4.','R5.','R6.','R7.','R8.','R9.'
|
||||
,,'R10.','R11.','R12.','R13.','R14.','R15.','AP.','FP.','SP.'
|
||||
,,'PC.'
|
||||
//
|
||||
|
||||
DO 10 I=1,20
|
||||
IF (IDENT.EQ.BAD_ID(I)) THEN
|
||||
PUBLIQUE=GOOD_ID(I)
|
||||
GO TO 20
|
||||
ENDIF
|
||||
10 CONTINUE
|
||||
PUBLIQUE=IDENT(1:31) ! Use first 31 chars of name.
|
||||
SAME_OVERLAY=.FALSE.
|
||||
20 IF (OVERLAY_FLAG) THEN
|
||||
DO 30 I=1,LAST_GLOBAL
|
||||
IF (PUBLIQUE.EQ.GLOBAL_SYMBOL(I)) GO TO 40
|
||||
30 CONTINUE
|
||||
SAME_OVERLAY=.TRUE.
|
||||
PUBLIQUE(OVERLAY_PREFIX(0)+1:)='.'//PUBLIQUE
|
||||
CALL MAKE_CHARS(PUBLIQUE,OVERLAY_PREFIX)
|
||||
ENDIF
|
||||
40 PUBLIQUE(32:32)=' ' ! Truncate to 31 chars.
|
||||
RETURN
|
||||
END
|
||||
C---------------------------------------------------------------------
|
||||
CHARACTER*32 FUNCTION VECNIQUE(IDENT)
|
||||
IMPLICIT INTEGER*2 (A-Z)
|
||||
CHARACTER*32 IDENT
|
||||
C
|
||||
VECNIQUE='V.'//IDENT
|
||||
VECNIQUE(32:32)=' ' ! Truncate to 31 chars.
|
||||
RETURN
|
||||
END
|
||||
134
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/units.for
Normal file
134
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/units.for
Normal file
@@ -0,0 +1,134 @@
|
||||
C***********************************************************************
|
||||
C
|
||||
C UNITS.FOR
|
||||
C
|
||||
C
|
||||
C D I S C L A I M E R N O T I C E
|
||||
C ------------------- -----------
|
||||
C
|
||||
C This document and/or portions of the material and data furnished
|
||||
C herewith, was developed under sponsorship of the U. S. Government.
|
||||
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
|
||||
C University, nor their employees, nor their respective contractors,
|
||||
C subcontractors, or their employees, makes any warranty, express or
|
||||
C implied, or assumes any liability or responsibility for accuracy,
|
||||
C completeness or usefulness of any information, apparatus, product
|
||||
C or process disclosed, or represents that its use will not infringe
|
||||
C privately-owned rights. Mention of any product, its manufacturer,
|
||||
C or suppliers shall not, nor is it intended to, imply approval, dis-
|
||||
C approval, or fitness for any particular use. The U. S. and the
|
||||
C University at all times retain the right to use and disseminate same
|
||||
C for any purpose whatsoever. Such distribution shall be made by the
|
||||
C National Energy Software Center at the Argonne National Laboratory
|
||||
C and only subject to the distributee furnishing satisfactory proof
|
||||
C that he has a valid license from the Intel Corporation in effect.
|
||||
C
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
C This module of the PL/M-VAX compiler contains routines to process
|
||||
C one or a series of statement units, including any labels associated
|
||||
C with each statement unit.
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C R E V I S I O N H I S T O R Y
|
||||
C
|
||||
C 20OCT81 Alex Hunter 1. Added disclaimer notice. (V5.4)
|
||||
C 21OCT81 Alex Hunter 1. Basic block analysis. (V5.5)
|
||||
C 09NOV81 Alex Hunter 1. Implement BBA assumption. (V5.9)
|
||||
C 14NOV81 Alex Hunter 1. Put FPSP. in P_APD psect. (V6.2)
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE UNITS
|
||||
INCLUDE 'PLMCOM.FOR/NOLIST'
|
||||
CHARACTER*32 TEMP_ID
|
||||
|
||||
CALL PSECT(P_CODE)
|
||||
FLAG=1
|
||||
GO TO 10
|
||||
C------------------------------
|
||||
ENTRY UNIT
|
||||
C------------------------------
|
||||
FLAG=2
|
||||
10 CALL PUSH(FLAG,1)
|
||||
TEMP_ID=IDENTIFIER
|
||||
|
||||
IF (NLABELS.NE.0) CALL BREAK
|
||||
|
||||
DO 18 I=1,NLABELS
|
||||
IDENTIFIER=LABELS(I)
|
||||
H=HASH(IDENTIFIER)
|
||||
SYMBOL_INDEX=HASH_BUCKET(H)
|
||||
12 IF (SYMBOL_INDEX.GT.SYMBOL_TOP(BLOCK_LEVEL-1)) THEN
|
||||
IF (SYMBOL_PLM_ID(SYMBOL_INDEX).EQ.IDENTIFIER) GO TO 14
|
||||
SYMBOL_INDEX=SYMBOL_CHAIN(SYMBOL_INDEX)
|
||||
GO TO 12
|
||||
ENDIF
|
||||
C----------- NO ENTRY AT THIS BLOCK LEVEL -- MAKE ONE.
|
||||
CALL ENTER_SYMBOL
|
||||
SYMBOL_KIND(SYMBOL_INDEX)=S_LABEL
|
||||
14 SYMBOL_INDEX=HASH_BUCKET(H)
|
||||
16 IF (SYMBOL_INDEX.GT.SYMBOL_TOP(BLOCK_LEVEL-1)) THEN
|
||||
IF (SYMBOL_PLM_ID(SYMBOL_INDEX).EQ.IDENTIFIER) THEN
|
||||
IF (SYMBOL_KIND(SYMBOL_INDEX).NE.S_LABEL) THEN
|
||||
CALL ERROR('ALREADY DECLARED NOT A LABEL: '//IDENTIFIER)
|
||||
ELSEIF ((SYMBOL_FLAGS(SYMBOL_INDEX).AND.S_UNDEF).EQ.0) THEN
|
||||
CALL ERROR('MULTIPLY DEFINED LABEL: '//IDENTIFIER)
|
||||
ELSE
|
||||
SYMBOL_REF(SYMBOL_INDEX)=S_STATIC
|
||||
SYMBOL_FLAGS(SYMBOL_INDEX)=SYMBOL_FLAGS(SYMBOL_INDEX)
|
||||
# .AND..NOT.S_UNDEF
|
||||
CALL EMIT_LABEL(SYMBOL_INDEX)
|
||||
ENDIF
|
||||
ENDIF
|
||||
SYMBOL_INDEX=SYMBOL_CHAIN(SYMBOL_INDEX)
|
||||
GO TO 16
|
||||
ENDIF
|
||||
18 CONTINUE
|
||||
IDENTIFIER=TEMP_ID
|
||||
IF (NLABELS.GT.0) THEN
|
||||
LAST_LABEL=LABELS(NLABELS)
|
||||
PATH=.TRUE.
|
||||
IF (BLOCK_LEVEL.EQ.1) THEN
|
||||
CALL EMIT('MOVQ FPSP.,FP')
|
||||
IF (MODEL.EQ.1 .OR. MODEL.EQ.3) CALL EMIT('MOVAB S.,R10')
|
||||
ENDIF
|
||||
ELSE
|
||||
LAST_LABEL='.BLANK.'
|
||||
ENDIF
|
||||
NLABELS=0
|
||||
IF (.NOT.PATH.AND.TT.NE.K_END) THEN
|
||||
CALL WARN('NO PATH TO THIS STATEMENT')
|
||||
CALL BREAK
|
||||
PATH=.TRUE.
|
||||
ENDIF
|
||||
IF (TT.EQ.K_IF) THEN
|
||||
CODE=CONDITIONAL_CLAUSE(0)
|
||||
ELSEIF (TT.EQ.K_DO) THEN
|
||||
CODE=DO_BLOCK(0)
|
||||
ELSEIF (TT.EQ.ID) THEN
|
||||
CODE=ASSIGNMENT_STATEMENT(0)
|
||||
ELSEIF (TT.EQ.K_CALL) THEN
|
||||
CODE=CALL_STATEMENT(0)
|
||||
ELSEIF (TT.EQ.K_GO.OR.TT.EQ.K_GOTO) THEN
|
||||
CODE=GOTO_STATEMENT(0)
|
||||
ELSEIF (TT.EQ.K_RETURN) THEN
|
||||
CODE=RETURN_STATEMENT(0)
|
||||
ELSEIF (TT.EQ.K_DISABLE.OR.TT.EQ.K_ENABLE.OR.TT.EQ.K_HALT) THEN
|
||||
CODE=i8086_DEPENDENT_STATEMENTS(0)
|
||||
ELSEIF (TT.EQ.D_SEMI) THEN
|
||||
CODE=NULL
|
||||
CALL GETTOK
|
||||
ELSE
|
||||
CALL POP(FLAG,1)
|
||||
IF (FLAG.EQ.2) CALL MUSTBE(NT_STATEMENT)
|
||||
RETURN
|
||||
ENDIF
|
||||
IF (CODE.NE.NULL) THEN
|
||||
BASIC_BLOCK=MAKE_NODE(OP_THEN,BASIC_BLOCK,CODE,0,0,0)
|
||||
ENDIF
|
||||
IF (END_OF_BASIC_BLOCK .OR. .NOT.ASSUME_BBA) CALL BREAK
|
||||
CALL POP(FLAG,1)
|
||||
GO TO (10,20), FLAG
|
||||
20 RETURN
|
||||
END
|
||||
Reference in New Issue
Block a user