@X @~
~L3 COUK1247
80
~V7 56 2 -5
~D10
~H                    MUSS
~
~
~D10
~H             FTN071
~D10
~MMANCHESTER UNIVERSITY  -  CONFIDENTIAL~
~
~
                                                            ISSUE 10~
~V9 -1
~P
~V9 1
~YFTN071
~S1~M~OFORTRAN 77 COMPILER IMPLEMENTATION DESCRIPTION
~S1~M~OSection 7~
~S1~OSection 7. Assignment Statement Processing
~S1~O1.1 General Description
~BThis section of the compiler performs the semantic actions for
the following Fortran statements.~
~T# 25
~
#a) ASSIGNMENTS~
#b) LABEL ASSIGNMENTS~
#c) STATEMENT FUNCTIONS~
#d) DATA~
~BStatement functions are translated into MUTL subroutines.
Any variables of the enclosing program unit in a statement
function are accessed as local variables. Non character arguments
to a statement function are passed by value via variables, and
character arguments are passed by reference via variables. These
variables are declared within the enclosing program unit.
~S1~O1.2 Non Standard Features
~BThe use of Holleriths in DATA statements is implemented in
extension to the described standard. It is implemented in the
manner specified in appendix C of the Fortran 77
standard.
~S1~O2. Interfaces
~S1~O2.1 Section Interfaces Used
   Section 1 : (Configuration Section)~
   Section 2 : (Statement Driver)~
   Section 4 : (Syntax Analysis)~
   Section 6 : (Specification Part Declarations)~
   Section 8 : (Control Statements)~
   Section 11: (Expression Evalusation)~
   Section 12: (Property List Management)~
   Section 13: (Fault Monitoring)~
~S1~O2.2 Section Interface
Exported Types:~
   EQUIV.PROP~
Exported Scalars:~
   DATA.ST.CNT.G~
Exported Procedures:~
   ASSIGNMENT~
   LABEL.ASSIGNMENT~
   DATA~
~S1~O3. Implementation
~S1~O3.1 Outline of Operation
~S1~O3.1.1 ASSIGNMENT()
~BThis procedure performs the semantic processing for the ASSIGNMENT and
STATEMENT FUNCTION statement.
Since there is no syntactic difference between an assignment
and a statement function, semantic information and context are
used to distinguish between them. A statement function must
appear before the first executable statement of a program unit, the
left hand side of the statement must have an argument list
and the left hand side must have a name permissible as a statement
function.
~BFor an assignment statement the expression tree is reduced
by REDUCE.EXPR and then coded by CODE.EXPR.
~BFor a statement function an argument specification vector
is created which is later used in coding references to the
statement function. A new local property entry is created
for each dummy argument and a variable allocated for passing
the actual argument. All these dummy argument local property
entries are put in a forwards linked list STAT.FN.ARG.LIST,
this list is used in coding references to the statement function.
~BA MUTL subroutine is then created for the statement function
as follows:~
~T% 4
~
a)
~IThe expression tree for the RHS is scanned, nodes that refer
to a dummy argument are modified so that the node references
its newly created local property entry.~
~
b)
~IA result variable for the statement function is allocated, and the
expression tree modified so that the RHS is assigned to the result
variable.~
~
c)
~IA MUTL specification for the subroutine is given.~
~
d)
~IThe expression tree is reduced.~
~
e)
~IA subroutine body is created in which the expression tree
for the statement function is coded.~
~S1~O3.1.2 LABEL.ASSIGNMENT()
~BPerforms the semantic processing for the ASSIGN statement.
The code planted for label assignment is the same for
format and executable statement labels.~
~
~MA = internal identifierfor Label~
~NAcc => assign variable~
~S1~O3.1.3 DATA()
~BPerforms the semantic processing for the DATA statement.
Initialisation of items in the n-list of a DATA statement is
static.
~BThe MUTL procedures called for various types of n-list items
is as follows:
~S1a) Scalar variable~
~3
~
    TL.ASS (MUTL name of variable)~
    declare literal to be assigned~
    TL.ASS.VALUE (MUTL name of literal)~
    TL.ASS.END~
~0
~S1b) array element
~BAs scalar variable but TL.ASS.ADV is called to select the
appropriate element.
~S1c) array
~BAs scalar variable but a literal is declared and TL.ASS.VALUE
called for each element of the array.
~S1d) substring
~BAs scalar variable or array element but TL.ASS.ADV called
to select the position within the string for initialisation.
~BNote that for items of complex type TL.ASS.VALUE is called
twice to assign values to the real and the complex components
of the type.
~BEach pair of n-list, c-lists is processed in turn. Checks
are made to ensure that the n-list items are of the correct
kind, and that the type of the corresponding c-list item is
of compatible type. If the types are compatible but different,
then the constant entry is copied and its type changed to that
of the n-list item. It is necessary to copy since there may
be a repeat count on the constant or the constant might be a
Parameter constant.
~BImplied DO lists in DATA statements are implemented in
two stages.
~BIn the first stage a constant entry is allocated for the
DO list control variable, the expression tree for each
n-list item is scanned and nodes that refer to the control
variable are modified to refer to its associated constant.
~BDuring the second stage the DO list constant is given
the values as specified by the DO parameter. For each such
value each item in the n-list of the DO is then assigned a
value from the constant list.
~BThe procedure PRE.PROCESS.DO.LIST performs the first stage
action and ASSIGN.DO.LIST the second. Since implied DO list
may be nested both these procedures are called recursively
when nesting occurs.
~S1~O3.2 Data Structures
~BA Data-DO stack is used in processing DO implied lists
in a DATA statement.
~BFor each level of nesting of implied DO's a three word
entry is allocated~
~3
~
WORD 0  Index into analysis record of DO implied list~
WORD 1  Index into analysis record of enclosing DO entry~
WORD 2  Address of constant used to hold the value of the~
        DO control variable.~
~0
~BDATA.ST.CNT.G is a count of the number of DATA statements in
a program unit.~
~Y
~V9 -1
~P
~D15
~HFLOWCHARTS
~
~
~H                FTN071
~V9 -1
~F
@TITLE FTN07(1,10)
@COL 1S-4R-5R-2R-3F
@FLOW 1-4-5-2-3
@BOX 1.0
ASSIGNMENT STATEMENTS
@BOX 2.0
ASSIGNMENT AND
STATEMENT FNS:7.1:
LABEL ASSIGN:7.2:
DATA:7.3:
@BOX 3.0
END
@BOX 4.0
EXTERNAL ENVIRONMENT
MODULE HEADING
@BOX 5.0
EXPORTED GLOBALS
@BOX 11.0
EXPORT OF TYPES NEEDED FOR IMPORTS
@BOX 1.1
@BOX 2.1
;PSPEC ASSIGNMENT()
;PSPEC LABEL.ASSIGNMENT()
;PSPEC DATA()
#FTN07.1
#FTN07.2
#FTN07.3
@BOX 3.1
;*END
@BOX 4.1
#FTN07/1
;MODULE (ASSIGNMENT,LABEL.ASSIGNMENT,DATA,
        DATA.ST.CNT.G);
@BOX 5.1
;*GLOBAL 2
;$IN DATA.ST.CNT.G
; *GLOBAL 0
@END
@TITLE FTN07/1(1,11)
@COL 1S-2R
@COL 3R-4R-5R-6F
@FLOW 1-2-3-4-5-6
@BOX 1.0
EXTERNAL ENVIRONMENT
@BOX 2.0
TYPES
@BOX 3.0
LITERALS
@BOX 4.0
VARIABLES
@BOX 5.0
PROCEDURES
@BOX 6.0
END
@BOX 1.1
@BOX 2.1
;IMPORT  TYPE EQUIV.PROP
;TYPE PROPS;
;TYPE NAME.T IS $AD[$LO8] NAME :: ??? JM 27-DEC-82
;TYPE LOCAL.PROP;
;TYPE CONST.PROP;
;TYPE GLOBAL.PROP IS
       ADDR GLOBAL.PROP G.NEXT.P
       NAME.T G.NAME
       $LO8 G.KIND
       $LO16 G.TL.NAME
       ADDR [$LO8] G.ARG.SPEC.P
;TYPE L.ALT.TYPE IS
       ADDR CONST.PROP L.CONST.P OR
       ADDR EQUIV.PROP L.EQT.P
       $IN L.DISP OR
       ADDR [$LO8] L.ARG.SPEC.P
       $LO8 L.INTR.NO
       $LO16 L.CH.RES.NAME
       $LO16 L.SPEC.TL.NAME OR
       ADDR [$IN] L.AS.DUMP
       ADDR [PROPS] L.PROPS.T.DUMP
;TYPE LOCAL.PROP IS
       ADDR LOCAL.PROP L.NEXT.P
       NAME.T L.NAME
       ADDR LOCAL.PROP L.LINK1, L.LINK2
       $LO8 LTYPE
       $LO16 LSPECS, LKIND
       $IN L.LEN
       $LO16 L.TL.NAME
       ADDR [$IN] L.ARR.SPEC.P
       L.ALT.TYPE L.ALT
;TYPE COMMON.PROP IS
       ADDR COMMON.PROP C.NEXT.P
       NAME.T C.NAME
       $LO8 C.KIND
       ADDR LOCAL.PROP C.HEAD, C.TAIL
       ADDR C.SIZE
       ADDR COMMON.PROP C.PREV.P
       $LO8 C.AREA.NO
;TYPE LABEL.PROP IS
       ADDR LABEL.PROP S.NEXT.P
       $LO24 S.NAME
       $LO8 S.KIND
       $LO16 S.LEVEL, S.BLOCK, S.TL.NAME, S.ID
;TYPE CONST.PROP IS
       $IN32 INT.CONST OR
       $RE32 REAL.CONST OR
       $RE64 DP.CONST OR
       $RE32 R.COMP.CONST, I.COMP.CONST OR
       $LO16 LOG.CONST OR
       ADDR[$LO8] CH.CONST OR
       $LO64 T.CONST OR
       $LO8[8] H.CONST
       $LO8 H.PR :: @@@ BCT 30-DEC-82
TYPE PROPS IS
      $IN32 INT OR
      ADDR ADDRESS OR
      ADDR LOCAL.PROP LOC OR
      ADDR GLOBAL.PROP GLOB OR
      ADDR COMMON.PROP COM OR
      ADDR CONST.PROP CONST
@BOX 3.1
;IMPORT LITERAL R.ACC.T.L,DP.ACC.T.L,I.ACC.T.L,
     L.ACC.T.L,AS.Z.L,PROPS.Z.L,GLOBAL.HASH.Z.L,DATA.DO.Z.L,LOCAL.SPACE,LINE.SPA
CE
;IMPORT LITERAL $LO8 SPACE.L
@BOX 4.1
; $IN STAT.AP.G,PROPS.I,EXEC.ST.CNT.G,MUTLN.G,END.AP.G,CUR.A.TYPE.G
; $IN [AS.Z.L] AS
; ADDR GLOBAL.PROP [GLOBAL.HASH.Z.L] G.HASH
; ADDR LOCAL.PROP F.L.PROP.G
; $LO8 PU.G
;PROPS[PROPS.Z.L] PROPS.T
@BOX 5.1
;PSPEC CHECK.IMPLICIT.DECL(ADDR LOCAL.PROP)/$IN
;PSPEC PROCESS.STAT.REF($IN,$LO24)/ADDR LABEL.PROP
;PSPEC REDUCE.EXPR($IN)/$IN
;PSPEC CODE.EXPR($IN,$IN)/$IN
;PSPEC CODE.SUBSCRIPTS($IN,$IN,$IN)/$IN
;PSPEC SET.A.TYPE($IN,$IN)
;PSPEC MUTL.TYPE($IN, $IN)/$IN
;PSPEC V.DECL($IN, $IN, $IN)/$IN
;PSPEC COPY.CONST(ADDR CONST.PROP,$IN)/ADDR CONST.PROP
;PSPEC CHANGE.CONST.TYPE(ADDR CONST.PROP,$IN,$IN)
;PSPEC PL.VAR.OP($IN,ADDR LOCAL.PROP)
;PSPEC ADD.L.NAME(ADDR NAME.T)/ADDR LOCAL.PROP
;PSPEC FAULT($IN,$IN)
;PSPEC EVAL.CONST.EXPR($IN,$IN)/ADDR CONST.PROP
;P.SPEC DECL.ARITH.CONST(ADDR CONST.PROP,$IN)/$IN
;P.SPEC MAKE.LO8($IN,$IN)/ADDR [$LO8]
;P.SPEC MAKE.IN($IN,$IN)/ADDR [$IN]
;P.SPEC MAKE.LOCAL.PROP($IN)/ADDR LOCAL.PROP
;P.SPEC MAKE.CONST.PROP($IN)/ADDR CONST.PROP
;L.SPEC TL.S.DECL(ADDR[$LO8],$IN,ADDR)
;L.SPEC TL.PROC.SPEC(ADDR[$LO8],$IN)
;L.SPEC TL.PROC.RESULT($IN)
;L.SPEC TL.PROC($IN)
;L.SPEC TL.PL($IN,$IN)
;L.SPEC TL.END.PROC()
;L.SPEC TL.LABEL.SPEC(ADDR [$LO8],$IN)
;L.SPEC TL.LABEL($IN)
;L.SPEC TL.ASS($IN,$IN)
;L.SPEC TL.ASS.ADV($IN)
;L.SPEC TL.ASS.END()
;L.SPEC TL.ASS.VALUE($IN,$IN)
;L.SPEC TL.C.LIT.16($IN,$IN16)
;L.SPEC TL.C.LIT.32($IN,$IN32)
@END
@TITLE FTN07.1(1,11)
@COL 1S-2T-3T-4R-5F
@COL 6T-7T-8R-9R
@ROW 3-6
@FLOW 1-2N-3N-4-5
@FLOW 2Y-6N-7N-8-9
@FLOW 6Y-3Y-5
@FLOW 7Y-3
@BOX 1.0
ASSIGNMENT()
@BOX 2.0
FIRST EXECUTABLE
STATEMENT?
@BOX 3.0
REDUCE EXPR:11.2:
FAULTY?
@BOX 4.0
CODE.EXPR:11.3:
@BOX 5.0
END
@BOX 6.0
LH SIDE HAS NO
ARGUMENT LIST
@BOX 7.0
LH SIDE IS ALREADY
DEFINED OR IS A DUMMY ARGUMENT
OR IN A NON TYPE SPECIFICATION
STATEMENT?

@BOX 8.0
RESET STAT CNT TO ZERO
@BOX 9.0
PROCESS STATEMENT
FUNCTION:7.1.1:
@BOX 1.1
;PROC ASSIGNMENT
;$LO8 L
;$IN LHAP,RMUTLN,SMUTLN,SAP,N,ARG.AP,EXPR.AP,AP,TY,I,J,RTY,ARG.CNT
;$IN T,TMUTLN
;ADDR LOCAL.PROP LP,GL.P,STLP,LP1,RLP,OLD.LP
;ADDR [$LO8] A.SP
;ADDR [$IN] A.L
;ADDR GLOBAL.PROP GP
;LITERAL/ADDR GLOBAL.PROP NIL.GP=
;LITERAL/ADDR LOCAL.PROP NIL.LP=
;LITERAL/ADDR[$LO8] NILSTR=
;STAT.AP.G=>AP
@BOX 2.1
;IF EXEC.ST.CNT.G=1
@BOX 3.1
;IF REDUCE.EXPR(AP) = -1
@BOX 4.1
;CODE.EXPR(AP,%22)
@BOX 5.1
;END
@BOX 6.1
;IF AS[AS[AP+1]=>LHAP] & %C00/= %400
@BOX 7.1
;LOC OF PROPS.T[AS[LHAP+2]]=> ST.LP
;IF L.KIND OF ST.LP^ /=0 OR L.SPECS OF ST.LP^ & %F7F /= 0
@BOX 8.1
;0=>EXEC.ST.CNT.G
@BOX 9.1
#FTN07.1.1
@END

@TITLE FTN07.1.1(1,11)
@COL 1S-22R-2R-3R-4R-5T-6T-7R-8R-9R-17R-18R-19F
@COL 20R-21C-10R-11R-13R-14R-15R-16R
@ROW 20-7
@FLOW 1-22-2-3-4-5N-6N-7-8-9-4
@FLOW 5Y-10-11-13-14-15-16-17-18-19
@FLOW 6-20-21
@BOX 1.0
PROCESS STATEMENT FN
@BOX 22.0
INTERNAL PROCS
SUBSTITUTE ST.FN.ARGS:7.1.1.1:
@BOX 2.0
GET NO OF ARGUMENTS
@BOX 3.0
INITIALISE ARG SPEC LIST IN LOCAL SPACE
INITIALISE LIST OR ARG PROP PTRS FOR RHS ARG SUBSTITUTION
INITIALISE STAT FN ARG LIST
@BOX 4.0
GET ARGUMENT
@BOX 5.0
NO MORE ARGUMENTS
@BOX 6.0
ARGUMENT NOT JUST A NAME?
@BOX 7.0
GET ITS TYPE
ADD ARG ENTRY TO STAT FN SPEC
@BOX 8.0
ALLOCATE A PROP ENTRY FOR ARGUMENT AND INITIALISE
@BOX 9.0
ADD TO LIST OF ARG PROP PTR
ADD TO STAT FN ARG LIST
@BOX 10.0
ALLOCATE A PROP ENTRY FOR RESULT AND INITIALISE
ADD RESULT BYTE TO ARG SPECIFICATION
@BOX 11.0
SUSTITUTE ARGS IN RHS:7.1.1.1:
@BOX 13.0
REDUCE RHS EXPR:11.2:
@BOX 14.0
DECLARE A TL PROC SPEC
FOR STAT FN TO BE A STATIC SUBROUTINE
@BOX 15.0
START SUBROUTINE BODY
SAVE MUTL NAME OF STAT FN
@BOX 16.0
FOR CHAR FNS
PLANT MOV
   LHS = RESULT
   RHS = EXPR
FOR NON CHAR FNS
CODE EXPR
@BOX 17.0
FOR NON-CHAR FNS
CONVERT RHS TYPE IF NECESSARY
PLANT A=RESULT
FOR CHAR FNS
PLANT EMOV
PLANT RETURN
@BOX 18.0
END SUBROUTINE BODY
UPDATE STAT FN PROPS
@BOX 19.0
END
@BOX 20.0
FAULT
@BOX 21.0
END
@BOX 1.1
@BOX 22.1
;PSPEC SUBSTITUTE.ST.FN.ARGS($IN)
#FTN07.1.1.1
@BOX 2.1
;AS[AS[LHAP+4]=> SAP=>ARG.AP]=>N=>ARG.CNT
@BOX 3.1
;MAKE.LO8(N*2+3,LOCAL.SPACE)=>A.SP
;MAKE.IN(N*3,LINE.SPACE)=>A.L
;0=>J=>I
;NIL.LP=>L.LINK2 OF ST.LP^
;ST.LP=>OLD.LP
@BOX 4.1
;AS[1+>ARG.AP]=>EXPR.AP
@BOX 5.1
;IF 1->N <0
@BOX 6.1
;IF AS[EXPR.AP] & %C1F /= %1F
@BOX 7.1
;AS[EXPR.AP+2]=>A.L^[J]=>T;
;LOC OF PROPS.T[T] => LP
;0 => L
;IF L.TYPE OF LP^=>TY =5 THEN %D=> TY
 ELSE L.LEN OF LP^ => L FI
;%20 !TY=>A.SP^[2+>I]
;L => A.SP^[1+I]
@BOX 8.1
;MAKE.LOCAL.PROP(LOCAL.SPACE)=>LP1
;IF TY & 7  => L.TYPE OF LP1^ /= 5 THEN
  ;%80=>T ELSE %280=>T FI
;T=> L.SPECS OF LP1^ & %200 => A.L^[J+2]
;1=> L.KIND OF LP1^
;L.LEN OF LP^ => L.LEN OF LP1^
;IF TY=>T = 5 THEN 6 => T => L FI
;V.DECL(T,L,0)=>L.TL.NAME OF LP1^
@BOX 9.1
;LP1 => LOC OF PROPS.T[1+>PROPS.I]
;PROPS.I => A.L^[J+1]
;3+>J
;NIL.LP=>L.LINK2 OF LP1^
;LP1=>L.LINK2 OF OLD.LP^=>OLD.LP
@BOX 10.1
;MAKE.LOCAL.PROP(LINESPACE)=>R.LP
;L.TYPE OF ST.LP^ => TY=>A.SP^[0]
;%FF=>A.SP^[2+I]
;TY=>RTY=>L.TYPE OF R.LP^
;L.LEN OF ST.LP^ => T =>  L.LEN OF R.LP^
;%80=>L.SPECS OF R.LP^
;1=>L.KIND OF R.LP^
;IF TY = 5 THEN
    0 => L
   ;V.DECL(5,0,T)
         => R.MUTLN
         => L.TL.NAME OF R.LP^
 ELSE T => L
;FI
; L => A.SP^[1]
@BOX 11.1
;SUBSTITUTE.ST.FN.ARGS(AS[AP+2]=>AP)
@BOX 13.1
;REDUCE.EXPR(AP)
@BOX 14.1
;TL.PROC.SPEC(NAME OF L.NAME  OF ST.LP^,%3) :: ??? JM 27-DEC-82
;IF RTY = 5 THEN %83 => T
 ELSE MUTL.TYPE(RTY,L) => T FI
;TL.PROC.RESULT(T)
@BOX 15.1
;TL.PROC(MUTLN.G=>L.TL.NAME OF ST.LP^)
;1+>MUTL.N.G=>SMUTLN
@BOX 16.1
;IF TY=5 THEN
   ;SET.A.TYPE(5,0)
   ;TL.PL(%22,0)
   ;TL.PL(%20,RMUTLN)
   ;CODE.EXPR(AP,%21)
;ELSE
  ;CODE.EXPR(AP,%22)
;FI
@BOX 17.1
;IF TY /= 5 THEN
   ;SET.A.TYPE(%10!TY, L)
   ;%3000=>T
;ELSE
   ;TL.PL(%23,0)
   ;0 =>T
;FI
;TL.PL(%43,T)
@BOX 18.1
;TL.END.PROC()
;SMUTLN=>MUTL.N.G
;4=> L.KIND OF ST.LP^
;A.SP=> L.ARG.SPEC.P OF L.ALT OF ST.LP^
@BOX 19.1
;EXIT
@BOX 20.1
;ST.LP => F.L.PROP.G
;FAULT(59,1)
@BOX 21.1
;EXIT
@END
@TITLE FTN07.1.1.1(1,10)
@COL 1S-2T-18T-3T-4R-5T-6R-7T-8R-9R-10T-11T-12R-13T-14R-15F
@COL 16R-17R
@ROW 3-16
@FLOW 1-2N-18N-3-4-5N-6-7N-8-9-7Y-10N-11N-12-13N-14-15
@FLOW 2Y-16-17-15
@FLOW 3Y-5Y-10
@FLOW 10Y-15
@FLOW 11Y-13Y-15
@FLOW 18Y-10
@BOX 1.0
SUBSTITUTE STAT FN ARGS(EXPR.AP)
@BOX 2.0
NOT A TERMINAL NODE?
@BOX 18.0
OPERAND A CONSTANT?
@BOX 3.0
NODE NOT A DUMMY ARGUMENT OF
STAT FN?
@BOX 4.0
SUBSTITUTE PROP PTR IN
NODE
@BOX 5.0
NO ARGUMENT SUBSCRIPT LIST?
@BOX 6.0
GET FIRST EXPR IN LIST
@BOX 7.0
END OF LIST?
@BOX 8.0
SUBSTITUTE IN ARG EXPR:7.1.1.1:
@BOX 9.0
GET NEXT EXPR IN LIST
@BOX 10.0
NOT A SUBSTRING?
@BOX 11.0
LOWER SPECIFIER OF SUBSTRING NOT SPECIFIED
@BOX 12.0
SUBSTITUTE IN LOWER SPECIFIER EXPR:7.1.1.1:
@BOX 13.0
UPPER SPECIFIER OF SUBSTRING NOT SPECIFIED
@BOX 14.0
SUBSTITUTE IN UPPER SPECIFIER EXPR:7.1.1.1:
@BOX 15.0
END
@BOX 16.0
SUBSTITUTE IN LHS
OPERAND:7.1.1.1:
@BOX 17.0
SUBSTITUE IN RHS
OPERAND:7.1.1.1:
@BOX 1.1
;PROC SUBSTITUTE.ST.FN.ARGS(AP)
;$IN N0,I,K,N,T,SAP



@BOX 2.1
;IF AS[AP]=>N0 & %10 = 0
@BOX 18.1
;IF N0 & %F = 0
@BOX 3.1
;-1=>I
;WHILE 1+>I < ARG.CNT AND
   LOC OF PROPS.T[AS[AP+2]] /=
        LOC OF PROPS.T[A.L^[I*3]]
   DO::NOTHING
;OD
;IF I >= ARG.CNT
@BOX 4.1
;A.L^[I*3+1]=> AS[AP+2]
;AS[AP] & %FDFF ! A.L^[I*3+2] => AS[AP]
@BOX 5.1
;0=>K
;IF N0 & %400 =0
@BOX 6.1
;1=>K
;AS[AS[AP+4]=>SAP]=>N
@BOX 7.1
;IF 1->N <0
@BOX 8.1
;SUBSTITUTE.ST.FN.ARGS(AS[1+>SAP])
@BOX 9.1
::NO CODE
@BOX 10.1
;IF N0 & %800=0
@BOX 11.1
;IF AS[AS[AP+4+K]=>SAP]=>T=0
@BOX 12.1
;SUBSTITUTE.ST.FN.ARGS(T)
@BOX 13.1
;IF AS[SAP+1]=>T=0
@BOX 14.1
;SUBSTITUTE.ST.FN.ARGS(T)
@BOX 15.1
;END
@BOX 16.1
;SUBSTITUTE.ST.FN.ARGS(AS[AP+1])
@BOX 17.1
;SUBSTITUTE.ST.FN.ARGS(AS[AP+2])
@END

@TITLE FTN07.2(1,11)
@COL 1S-8T-15T-16R-9T-10T-11T-4R-5R-6F
@COL 7R
@ROW 4-7
@FLOW 1-8N-15N-16-9N-10N-11N-4-5-6
@FLOW 11Y-6
@FLOW 15Y-9
@FLOW 10Y-7-6
@FLOW 8Y-7
@FLOW 9Y-4
@BOX 1.0
LABEL ASSIGNMENT()
@BOX 8.0
NAME OF CORRECT TYPE
@BOX 9.0
NAME IS A VARIABLE
@BOX 10.0
NAME IS NOT UNDEFINED
@BOX 11.0
DECLARE IMPLICIT VARIABLE:6.5:
INVALID?
@BOX 4.0
ADD.S.NAME(LABEL):12.4:
NOTE ASSIGNED
@BOX 5.0
CODE LABEL ASSIGN
@BOX 6.0
END
@BOX 7.0
FAULT
@BOX 15.0
NOT ASSIGNING TO A DO VARIABLE
@BOX 16.0
WARNING
@BOX 1.1
;PROC LABEL.ASSIGNMENT
;$IN AP,K,N
;LITERAL/ADDR [$LO8] NIL.STR=
;ADDR LOCAL.PROP LP
;ADDR LABEL.PROP SP
@BOX 8.1
;LOC OF PROPS.T[AS[STAT.AP.G=>AP+1]]=>LP=>F.L.PROP.G
;IF L.TYPE OF LP^ /=3
@BOX 9.1
;IF L.KIND OF LP^=>K=1
@BOX 10.1
;IF K /= 0
@BOX 11.1
;IF CHECK.IMPLICIT.DECL(LP) /= 0
@BOX 4.1
;PROCESS.STAT.REF(%86,INT OF PROPS.T[AS[AP]]) =>SP
; %80 !> S.KIND OF SP^
@BOX 5.1
;SET.A.TYPE(3,L.LEN OF LP^)
;TL.C.LIT.16(%84, S.ID OF S.P^)
;TL.PL(%22, 0)
;PL.VAR.OP(%20, LP)
@BOX 6.1
;END
@BOX 7.1
;FAULT(36,1)
@BOX 15.1
;IF L.SPECS OF LP^ & %400 = 0
@BOX 16.1
;FAULT(334, 1)
@END
@TITLE FTN07.3(1,11)
@COL 1S-12R-2R-3R-4T-5R-6T-7T-8T-9F
@COL 14C-13C-10R-11R
@ROW 5-10
@ROW 8-11
@ROW 12-14
@FLOW 1-12-2-3-4N-5-6N-7N-8N-9
@FLOW 4Y-10-6Y-4
@FLOW 7Y-11-9
@FLOW 8Y-3
@FLOW 14-13
@BOX 1.0
DATA
@BOX 12.0
INTERNAL PROCS
ASIGN.CONST.TO.ITEM:7.3.1:
GET.CONST.VALUE:7.3.3:
@BOX 2.0
INCR DATA STAT CNT
OBTAIN FIRST NLIST, CLIST
INIT REPEAT COUNT FOR C.LIST
@BOX 3.0
OBTAIN FIRST NLIST ITEM
AND FIRST C.LIST ITEM
@BOX 4.0
A DO LIST?
@BOX 5.0
ASSIGN CONST TO ITEM:7.3.1:
@BOX 6.0
ANY MORE NLIST ITEMS?
@BOX 7.0
ANY MORE CLIST ITEMS?
@BOX 8.0
ANY MORE NLIST, CLISTS?
@BOX 9.0
END
@BOX 10.0
ASSIGN DO LIST:7.3.2
@BOX 11.0
FAULT
@BOX 13.0
END
@BOX 14.0
NEXT.STAT
@BOX 1.1
;PROC DATA
;$IN AP, N.AP, C.AP, RC, HC, DD.P, I
;$IN[DATA.DO.Z.L] D.D
;ADDR [$LO8] HOLL.P
;$IN CUR.CONST.TY
;PROPS CUR.CONST.PR
;ADDR [$IN] AS.DUMP
;LABEL NEXT.STAT
;->PAST
;NEXT.STATL:
;EXIT
;PAST:
;NEXT.STATL => NEXT.STAT
@BOX 12.1
;PSPEC ASSIGN.CONST.TO.ITEM($IN)
;PSPEC GET.CONST.VALUE($IN,$IN)
#FTN07.3.1
#FTN07.3.3
@BOX 2.1
;1+>DATA.ST.CNT.G
;-1 => RC => HC
;STAT.AP.G=> AP
@BOX 3.1
;AS[AP] => N.AP
;AS[AP+1] => C.AP
@BOX 4.1
;IF AS[AS[NAP]] = 0
@BOX 5.1
;ASSIGN.CONST.TO.ITEM(AS[N.AP])
@BOX 6.1
;IF AS[1+>NAP] /= -1
@BOX 7.1
;IF AS[CAP] /= -1
@BOX 8.1
;IF AS[2+>AP] /= -1
@BOX 9.1
;END
@BOX 13.1
::IN BOX 1
@BOX 14.1
::IN BOX 1
@BOX 10.1
#FTN07.3.2
@BOX 11.1
;FAULT(60,1)
@END
@TITLE FTN07.3.1(1,11)
@COL 14N-15T-16T-17T-33R-18T-34R-19R-20C
@COL 1S-2T-3T-32T-25T-4N-6R-7T-8T-9T-10R-11T-12R-13R-24R-26F
@COL 31R-30C-21R-22R-23T
@ROW 14-25-31
@ROW 8-21
@FLOW 1-2N-3N-32N-25Y-15N-16Y-6-7N-8N-9-10-11N-12-13-24-26
@FLOW 3Y-30
@FLOW 32Y-31-30
@FLOW 2Y-14-19-20
@FLOW 16N-17N-33-6
@FLOW 17Y-18N-34-6
@FLOW 15Y-19
@FLOW 18Y-6
@FLOW 7Y-21-22-23N-24
@FLOW 23Y-22
@FLOW 8Y-11Y-13
@FLOW 9Y-20
@FLOW 25N-4-19
@BOX 1.0
ASSIGN.CONST.TO.ITEM(ITEM.AP)
@BOX 2.0
NOTE ITEM TYPE
ITEM A DUMMY OR AN ENCLOSING
PROGRAM UNIT
@BOX 25.0
ITEM A VARIABLE OR AN ARRAY
@BOX 3.0
CHECK IMPLICIT DECLARATION:6.5:
INVALID?
@BOX 30.0
NEXT.STAT
@BOX 6.0
NOTE NO OF
ELEMENTS IN ITEM
TL ASSIGN VARIABLE
@BOX 7.0
COMPLETE ARRAY ASSIGNMENT?
@BOX 8.0
NOT ARRAY ELEMENT?
@BOX 9.0
CODE.SUBSCRIPTS:11.4:
INVALID?
@BOX 10.0
TL.ADV TO APPROPRIATE EL
@BOX 11.0
NOT A SUBSTRING?
@BOX 12.0
PROCESS SUBSTRING:7.3.1.1:
@BOX 13.0
GET.CONST.VALUE:7.3.3:
@BOX 24.0
TL.ASS.END
@BOX 26.0
END
@BOX 15.0
SUBSCRIPTS ON VARIABLE OR
INCORRECT SUBSTRING USAGE?
@BOX 16.0
ITEM NOT IN COMMON
@BOX 17.0
NAMED COMMON?
@BOX 18.0
IN BLOCK DATA?
@BOX 19.0
FAULT
@BOX 20.0
NEXT STAT
@BOX 21.0
SET ARRAY SIZE
INIT ARRAY ASSIGNMENT
@BOX 22.0
GET.CONST.VALUE:7.3.3:
@BOX 23.0
ANY MORE ARRAY ELEMENTS
TO BE ASSIGNED
@BOX 31.0
FAULT
@BOX 32.0
ITEM ON STACK?
@BOX 33.0
ISSUE WARNING
@BOX 34.0
ISSUE WARNING
@BOX 1.1
;PROC ASSIGN.CONST.TO.ITEM(AP)
;$IN K,W1,W2,TY,LEN,S,SPEC,Z,STR.AP,J,D
;ADDR LOCAL.PROP LP
;ADDR [$IN] ARR.P
;$IN LS,US
;ADDR CONST.PROP CP
;LITERAL/ADDR CONST.PROP NIL.C=
;AS[AP+1]=>W1
;AS[AP+2]=>W2
@BOX 2.1
;LOC OF PROPS.T[AS[AP]]=>L.P=>F.L.PROP.G
;L.TYPE OF LP^=>TY
;IF L.SPECS OF L.P^ => SPEC  & %A00 /=0
@BOX 3.1
;IF CHECK.IMPLICIT.DECL(LP) /= 0
@BOX 30.1
;->NEXT.STAT
@BOX 25.1
;IF L.KIND OF L.P^ => K = 1 OR K = 2
@BOX 6.1
;L.LEN OF LP^=> LEN
;TL.ASS(L.TL.NAME OF LP^,-2)
@BOX 7.1
;IF K=2 AND W1=0
@BOX 8.1
;IF W1=0
@BOX 9.1
;IF CODE.SUBSCRIPTS(AS[AP],W1,1)=>S < 0
@BOX 10.1
;IF TY = 5 THEN LEN *> S FI
;IF S> 0 THEN
   ;TL.ASS.ADV(S)
;FI
@BOX 11.1
;IF W2 = 0
@BOX 12.1
#FTN07.3.1.1
@BOX 13.1
;GET.CONST.VALUE(TY,LEN)
@BOX 24.1
;TL.ASS.END()
@BOX 26.1
;END
@BOX 15.1
;IF K=1 AND W1 /=0 OR
   W2/=0 AND TY /=5
@BOX 16.1
;IF SPEC & %10 =0
@BOX 17.1
;IF SPEC & %1000 = 0
@BOX 18.1
;IF PUG =1
@BOX 19.1
;FAULT(61,1)
@BOX 20.1
;->NEXT.STAT
@BOX 21.1
;L.ARR.SPEC.P OF LP^ =>ARR.P
;ARR.P^[0]=>D
;1=>J ;1=>Z
;WHILE 1->D >=0 DO
   ;ARR.P^[3+>J]*>Z
;OD
@BOX 22.1
;GET.CONST.VALUE(TY,LEN)
@BOX 23.1
;IF 1->Z > 0
@BOX 31.1
; FAULT(137,1)
@BOX 32.1
; IF SPEC & %20 /= 0
@BOX 33.1
; FAULT (169,6)
@BOX 34.1
; FAULT (168,1)
@END
@TITLE FTN07.3.1.1(1,10)
@COL 12R-13R
@COL 1S-2T-3T-4T-5T-6R-7T-8T-9T-10R-11F
@COL 14R-15C
@FLOW 1-2N-3N-4N-5N-6-7N-8N-9N-10-11
@FLOW 2Y-12-7
@FLOW 3Y-15
@FLOW 4Y-14-15
@FLOW 5Y-7Y-13-10
@FLOW 8Y-15
@FLOW 9Y-14
@ROW 12-4
@ROW 13-9
@ROW 10-14
@BOX 1.0
PROCESS SUBSTRING EXPRS
@BOX 2.0
LOWER SPECIFIER NOT PRESENT?
@BOX 3.0
EVAL CONST EXPR:11.7:
FOR LOWER SPECIFIER EXPR
INVALID?
@BOX 4.0
OUT OF RANGE
@BOX 5.0
SUBSTRING STARTS ON
FIRST CHAR
@BOX 6.0
TL.ASS.ADV TO START
OF SUBSTRING
@BOX 7.0
UPPER SPECIFIER NOT
PRESENT?
@BOX 8.0
EVAL CONSTEXPR:11.7:
FOR UPPER SPECIFIER EXPR
INVALID?
@BOX 9.0
OUT OF RANGE OR
LOWER SPECIFIER
@BOX 10.0
CALCULATE LENGTH OF
SUBSTRING
@BOX 11.0
END
@BOX 12.0
SET LOWER SPECIFIER TO
ONE
@BOX 13.0
SET UPPER SPECIFIER TO
LENGTH
@BOX 14.0
FAULT
@BOX 15.0
NEXT STAT
@BOX 1.1
@BOX 2.1
;IF AS[W2]=>STR.AP=0
@BOX 3.1
;IF EVAL.CONST.EXPR(STR.AP,%13)=>C.P  = NIL.C
@BOX 4.1
;IF INT.CONST OF C.P^=> L.S <1 OR L.S>LEN
@BOX 5.1
;IF L.S=0
@BOX 6.1
;TL.ASS.ADV(L.S-1)
@BOX 7.1
;IF AS[W2+1]=>STR.AP=0
@BOX 8.1
;IF EVAL.CONST.EXPR(STR.AP,%13)=> C.P = NIL.C
@BOX 9.1
;IF INT.CONST OF C.P^=> US >LEN OR US<LS
@BOX 10.1
;US+1-LS=>LEN
@BOX 11.1
@BOX 12.1
;1=>LS
@BOX 13.1
;LEN=>US
@BOX 14.1
;LP => F.L.PROP.G
;FAULT(62,1)
@BOX 15.1
;->NEXT.STAT
@END
@TITLE FTN07.3.2(1,6)
@COL 1S-7R-2R-3R-4R-5R-6F
@FLOW 1-7-2-3-4-5-6
@BOX 1.0
ASSIGN DO LIST
@BOX 7.0
INTERNAL PROCS
PREPROCESS DO LIST:7.3.2.1:
ASSIGN DO LIST:7.3.2.1:
SUBSTITUTE :7.3.2.3:
@BOX 2.0
RESET DATA DO TABLE PTR
@BOX 3.0
PREPROCESS DATA DO LIST:7.3.2.1:
@BOX 4.0
COPY ANAL.RECORD TO DUMP
@BOX 5.0
ASSIGN DO LIST:7.3.2.2:
@BOX 6.0
END
@BOX 1.1
@BOX 2.1
;0=>DDP
@BOX 4.1
;MAKE.IN(END.AP.G,LINE.SPACE)=>AS.DUMP
;-1=>I
;WHILE 1+>I < END.AP.G DO
   ;AS[I]=>AS.DUMP^[I]
;OD
@BOX 7.1
;PSPEC PREPROCESS.DO.LIST($IN,$IN)
;PSPEC ASSIGN.DO.LIST($IN)
;PSPEC SUBSTITUTE($IN,$IN)
#FTN07.3.2.1
#FTN07.3.2.2
#FTN07.3.2.3
@BOX 3.1
;PREPROCESS.DO.LIST(AS[NAP]+1,-1)
@BOX 5.1
;ASSIGN.DO.LIST(0)
@BOX 6.1
@END
@TITLE FTN07.3.2.1(1,10)
@COL 1S-2R-3R-4R-5R-6T-7T-8R-9T-10F
@COL 11R
@ROW 8-11
@FLOW 1-2-3-4-5-6N-7N-8-9-10
@FLOW 6Y-11-9Y-6
@FLOW 7Y-9
@BOX 1.0
PREPROCESS DO LIST
(DO.LIST.AP,ENCLOSING.DO.ENTRY.PTR)
@BOX 2.0
ALLOCATE NEXT DATA DO ENTRY
AND INITIALISE
@BOX 3.0
ALLOCATE A CONSTANT FOR
DO CONTROL VARIABLE
@BOX 4.0
SUBSTITUTE DO LIST VARIABLES
IN EXPR FOR M1,M2,M3:7.3.2.3:
@BOX 5.0
GET FIRST ITEM IN NLIST OF DO
@BOX 6.0
ITEM IS A DATA DO-LIST
@BOX 7.0
ITEM HAS NO SUBSCRIPTS?
@BOX 8.0
SUBSTITUTE FOR DO LIST
VARIABLES IN ALL SUBSCRIPT
LIST EXPRESSIONS :7.3.2.3:
@BOX 9.0
NOT END OF NLIST OF DO?
@BOX 10.0
;END
@BOX 11.0
PREPROCESS DO.LIST:7.3.2.1
@BOX 1.1
;PROC PREPROCESS.DO.LIST(AP,EDDP)
;$IN P,T,NAP,W0,W1,SAP


@BOX 2.1
;D.D.P=>P+3=>D.D.P
;AP=>DD[P]
;EDDP=>DD[P+1]
@BOX 3.1
;MAKE.CONST.PROP(LINE.SPACE)=>CONST OF PROPS.T[1+>PROPS.I]
;PROPS.I => DD[P+2]
@BOX 4.1
;SUBSTITUTE(AS[AP+2],EDDP)
;SUBSTITUTE(AS[AP+3],EDDP)
;IF AS[AP+4]=>T >=0 THEN
   ;SUBSTITUTE(T,EDDP)
;FI
@BOX 5.1
;AS[AP]=>NAP
@BOX 6.1
;AS[AS[NAP]=>T+1=>W0]=>W1
;IF AS[T]=0
@BOX 7.1
;IF W1=0
@BOX 8.1
;AS[W1=>SAP]=>I
   ;WHILE 1->I >= 0 DO
      ;SUBSTITUTE(AS[1+>SAP],P)
   ;OD
@BOX 9.1
;IF AS[1+>NAP] >=0
@BOX 10.1
;END
@BOX 11.1
;PREPROCESS.DO.LIST(W0,P)
@END
@TITLE FTN07.3.2.2(1,10)
@COL 1S-2T-3T-4R-5R-6T-7R-8T-9R-10T-11R
@COL 12R-13C-14R-15F
@ROW 4-12
@ROW 7-14
@ROW 11-15
@FLOW 1-2N-3N-4-5-6N-7-8N-9-10N-11-5
@FLOW 2Y-13
@FLOW 3Y-12-13
@FLOW 6Y-14-8Y-6
@FLOW 10Y-15
@BOX 1.0
ASSIGN.DO.LIST(DATA.DO.ENTRY)
@BOX 2.0
EVALUATE EXPR OF IMPLIED
DO LOOP M1,M2,M3:11.7:
ANY INVALID?
@BOX 3.0
CALCULATE TRIP COUNT
INVALID?
@BOX 4.0
INIT CONTROL VARIABLE WITH M1
RESET NEXT DATA DO ENTRY
@BOX 5.0
GET FIRST ITEM OF N.LIST
OF DO LIST
@BOX 6.0
ITEM A DO LIST?
@BOX 7.0
ASSIGN CONST TO ITEM:7.3.1:
@BOX 8.0
NOT END OF NLIST OF DOLIST?
@BOX 9.0
INCR CONTROL VARIABLE
@BOX 10.0
DECR TRIP COUNT
IS IT ZERO
@BOX 11.0
RESET A/R FROM DUMP
@BOX 12.0
FAULT
@BOX 13.0
NEXT STAT
@BOX 14.0
ASSIGN DO LIST
:7.3.2.2:
@BOX 15.0
END
@BOX 1.1
;PROC ASSIGN.DO.LIST(P)
;$IN AP,N.DD.P,M1,M2,M3,TC,NAP,W0,I
;ADDR CONST.PROP CP
;LITERAL/ADDR CONST.PROP NIL.C=


@BOX 2.1
;DD[P]=>AP
;IF EVAL.CONST.EXPR(AS[AP+2],%B)=>CP /= NIL.C THEN
   ;INT.CONST OF CP^=> M1
   ;IF EVAL.CONST.EXPR(AS[AP+3],%B)=>CP /= NIL.C THEN
      ;INT.CONST OF CP^=>M2
      ;IF AS[AP+4]=>M3 < 0 THEN
         ;1=>M3
      ;ELSE
         ;IF EVAL.CONST.EXPR(M3,%B)=>CP /= NIL.C THEN
            ;INT.CONST OF CP^=>M3
         ;FI
      ;FI
;FI FI
;IF CP = NIL.C
@BOX 3.1
;IF (M2-M1+M3)/M3=>TC < 1
@BOX 4.1
;CONST OF PROPS.T[DD[P+2]] => CP
;M1=> INT.CONST OF CP^
;P+3=>N.DD.P
@BOX 5.1
;AS[AP]=>NAP
@BOX 6.1
;IF AS[AS[NAP]=>W0]=0
@BOX 7.1
;ASSIGN.CONST.TO.ITEM(W0)
@BOX 8.1
;IF AS[1+>NAP] > 0
@BOX 9.1
;M3+>INT.CONST OF CP^
@BOX 10.1
;IF 1->TC =< 0
@BOX 11.1
;-1 =>I
;WHILE 1+>I < END.AP.G DO
   ;AS.DUMP.^[I]=> AS[I]
;OD
@BOX 12.1
;FAULT(63,1)
@BOX 13.1
;->NEXT.STAT
@BOX 14.1
;ASSIGN.DO.LIST(N.DD.P)
@BOX 15.1
;END
@END
@TITLE FTN07.3.2.3(1,10)
@COL 1S-13T-2T-3R-4R-5F
@COL 6T-7T-8T-9R-10C-11R-12C
@ROW 3-6
@FLOW 1-13N-2N-3-4-5
@FLOW 2Y-6N-7N-8N-9-10
@FLOW 6Y-10
@FLOW 7Y-10
@FLOW 8Y-11-12
@FLOW 13Y-5
@BOX 1.0
SUBSTITUTE(EXPR.AD,DO.ENTRY)
@BOX 13.0
NO ENCLOSING DO IMPLIED
LISTS
@BOX 2.0
EXPR A TERMINAL NODE?
@BOX 3.0
SUBSTITUTE IN LH NODE
:7.3.2.3:
@BOX 4.0
:7.3.2.3 SUBSTITUTE IN RH NODE
@BOX 5.0
END
@BOX 6.0
NODE NOT A NAME?
@BOX 7.0
NODE IS NOT A DO CONTROL
VARIABLE
@BOX 8.0
NODE HAS SUBSCRIPTS OR
SUBSTRINGS
@BOX 9.0
CHANGE NODE TO AN
INTEGER CONSTANT NODE
@BOX 10.0
END
@BOX 11.0
FAULT
@BOX 12.0
NEXT STAT
@BOX 1.1
;PROC SUBSTITUTE(AP,DP)
;$IN N0,N2
;PROPS PR
@BOX 13.1
;IF DP < 0
@BOX 2.1
;IF AS[AP] => N0 & %10 /= 0
@BOX 3.1
;SUBSTITUTE(AS[AP+1],DP)
@BOX 4.1
;SUBSTITUTE(AS[AP+2],DP)
@BOX 5.1
;END
@BOX 6.1
;IF N0 & %F /= %F
@BOX 7.1
;AS[AP+2] => N2
;PROPS.T[N2] => PR
;WHILE DP >= 0 AND
   PROPS.T[AS[DD[DP]+1]] /= PR DO
   ;DD[DP+1] => DP
;OD
;IF DP < 0
@BOX 8.1
;IF N0 & %C00 /= 0
@BOX 9.1
;%3010 => AS[AP]
;DD[DP+2] => AS[AP+2]
@BOX 10.1
;EXIT
@BOX 11.1
;FAULT(%40,1)
@BOX 12.1
;->NEXT.STAT
@END
@TITLE FTN07.3.3(1,11)
@COL 18R-20R-22R
@COL 1S-46T-2T-3T-4T-49R-5T-6T-7R-8T-9R-10T-47T-11T-12R-13T-14T-16R-17F
@COL 23R-24T-25R-26R-27T-28R-29R-40C-41T-42R-44R-30R-31T-32R-33R-34R-35T
@ROW 18-4
@ROW 20-16
@FLOW 1-46N-2N-3N-4N-49-5N-6N-7-8N-9-10N-47N-11N-12-13N-14N-16-17
@FLOW 2Y-18-8
@FLOW 3Y-23-40
@FLOW 4Y-24N-25-5
@FLOW 24Y-26-40
@FLOW 5Y-26
@FLOW 6Y-27N-28-40
@FLOW 27Y-7
@FLOW 8Y-10Y-13
@FLOW 11Y-41Y-29-40
@FLOW 13Y-30-31N-32-34-35N-17
@FLOW 31Y-33-34
@FLOW 35Y-31
@FLOW 14Y-20-22-17
@FLOW 41N-42-44-14
@FLOW 46Y-44
@FLOW 47Y-12
@BOX 1.0
GET.CONST.VALUE(TYPE,LENGTH)
@BOX 2.0
REPEAT COUNT NOT EXHAUSTED?
@BOX 3.0
C LIST EMPTY?
@BOX 4.0
REPEAT COUNT A NAME?
@BOX 5.0
INVALID VALUE FOR REPEAT COUNT?
@BOX 6.0
CONSTANT LIST ITEM A NAME?
@BOX 7.0
SAVE PTR AND ITS TYPE AS
CURRENT CONSTANT
@BOX 8.0
DECR REPEAT COUNT
STILL NON ZERO?
@BOX 9.0
ADVANCE PTR TO NEXT ITEM
IN LIST
@BOX 10.0
CONSTANT OF SAME TYPE AS
N LIST ITEM
@BOX 11.0
CONSTANT OF INCOMP TYPE?
(77 STANDARD)
@BOX 12.0
COPY CONSTANT :11.8:
AND CHANGE ITS TYPE:11.1:
@BOX 13.0
CHAR CONST?
@BOX 14.0
COMPLEX CONST?
@BOX 16.0
DECL ARITH CONST:11.9:
TL ASSIGN VALUE TO ITEM
@BOX 17.0
END
@BOX 18.0
USE CURRENT CONSTANT
@BOX 20.0
DECL.ARITH.CONST:11.9:
FOR REAL PART
TL ASSIGN VALUE TO ITEM
@BOX 22.0
DECL.ARITH.CONST:11.9:
FOR IMAG PART
TL ASSIGN VALUE TO ITEM
@BOX 23.0
FAULT
@BOX 24.0
NOT AN INTEGER CONSTANT
NAME
@BOX 25.0
GET VALUE
@BOX 26.0
FAULT
@BOX 27.0
IS IT A CONSTANT NAME
@BOX 28.0
FAULT
@BOX 29.0
FAULT
@BOX 30.0
INIT CHAR ASSIGNMENT
@BOX 31.0
CHAR CONST EXHAUSTED
@BOX 32.0
GET NEXT CHAR FROM CONST
@BOX 33.0
SET CHAR = SPACE.L
@BOX 34.0
DECLARE CHAR AS TL.C.LIT
TL ASSIGN VALUE TO ITEM
@BOX 35.0
ANY MORE CHARS LEFT IN
STRING?
@BOX 40.0
NEXT.STAT:7.3:
@BOX 41.0
NOT A HOLLERITH OR CHAR
WITH ARITHMETIC TYPE
@BOX 42.0
ISSUE NON STANDARD WARNING IF CONSTANT
IS CHARACTER
UNPACK HOLLERITH
@BOX 44.0
UNPACK HOLL
NOTE IF EXHAUSTED
@BOX 46.0
CURRENT HOLL NOT EXHAUSTED?
@BOX 47.0
ARITH WITH TYPELESS
@BOX 49.0
GET REPEAT COUNT
@BOX 1.1
;PROC GET.CONST.VALUE(TY,LEN)
;$IN CTY,I,CH,H,L
;ADDR A
;ADDR LOCAL.PROP LP
;CONST.PROP HOLL
;ADDR [$LO8] CC
;ADDR CONST.PROP CP,DCP
;PROPS PR
@BOX 40.1
;->NEXT.STAT
@BOX 2.1
;IF RC > 0
@BOX 3.1
;IF AS[CAP]=>RC<0
@BOX 4.1
;IF AS[CAP+1]=1
@BOX 5.1
;IF RC < 1
@BOX 6.1
;PROP.S.T[AS[CAP+3]] => PR
;IF AS[CAP+2]=>CTY=9
@BOX 7.1
;PR=>CUR.CONST.PR
;CTY=>CUR.CONST.TY
@BOX 8.1
;IF 1->RC > 0
@BOX 9.1
;4+>CAP
@BOX 10.1
; 0 => H
;IF CTY >= 5 < 8 THEN
   ;ADDRESS OF PR => A
  ;MAKE($LO8,1320,A)=>CC
 ELSE CONST OF PR => DCP
;FI
;IF TY= CTY
@BOX 11.1
;IF TY>3 OR CTY > 3  OR [TY=1 AND CTY=2] OR
   [TY=2 AND CTY=1]
@BOX 12.1
;COPY.CONST(DCP,0)=>DCP
;CHANGE.CONST.TYPE(DCP,CTY,TY)
@BOX 13.1
;IF TY=5
@BOX 14.1
;IF TY=2
@BOX 16.1
;TL.ASS.VALUE(DECL.ARITH.CONST(DCP,TY!H),1)
@BOX 17.1
;END
@BOX 18.1
;CUR.CONST.PR=>PR
;CUR.CONST.TY=>CTY
@BOX 20.1
;TLASS.VALUE(DECL.ARITH.CONST
       (CONST OF PR,5!H),0)
@BOX 22.1
;TL.ASS.VALUE(DECL.ARITH.CONST
      (CONST OF PR,6!H),0)
@BOX 23.1
;FAULT(%41,1)
@BOX 24.1
;LOC OF PROPS.T[RC]=>L.P
;IF L.KIND OF L.P^ /=3 OR L.TYPE OF L.P^ /= 3
@BOX 25.1
;L.CONST.P OF L.ALT OF LP^ => CP
;INT.CONST OF CP^ =>RC
@BOX 26.1
;FAULT(%42,1)
@BOX 27.1
;LOC OF PR => L.P
;L.TYPE OF LP^ => CTY
;L.CONST.P OF L.ALT OF LP^ => CONST OF PR
;IF L.KIND OF L.P^ =3
@BOX 28.1
;LP => F.L.PROP.G
;FAULT(%44,1)
@BOX 29.1
;FAULT(%43,1)
@BOX 30.1
;0=>I
@BOX 31.1
;IF CC^[I]=>CH=0
@BOX 32.1
;1+>I
@BOX 33.1
;SPACE.L=>CH
@BOX 34.1
;TL.C.LIT.16(%80,CH)
;TL.ASS.VALUE(0,1)
@BOX 35.1
;IF 1->LEN > 0
@BOX 41.1
;IF CTY /= 5 /= 7 OR TY = 5
@BOX 42.1
;IF CTY = 5 THEN
   ;FAULT(167, 6)
;FI
;CC => HOLL.P
@BOX 44.1
; %100 => H
; ^HOLL => DCP
; 0 => I
; 1 <<- LEN => L
; WHILE HOLL.P^[1+>HC]=>CH /= 0 AND I < L DO
        CH => H.CONST[I] OF HOLL
       ;1+>I
        OD
; WHILE I < 8 DO
       SPACE.L => H.CONST[I] OF HOLL
      ;1 +> I
  OD
; IF CH = 0 THEN -1 => HC FI
; LEN => H.PR OF HOLL
@BOX 46.1
;IF HC >= 0
@BOX 47.1
; IF CTY = 8 AND TY /= 5
@BOX 49.1
;IF RC > 1 THEN
   ;INT OF PROPS.T[RC] => RC
;FI
@END

