@X @~
~L3 COUK1247
80
~V7 56 2 -5
~D10
~H                    MUSS
~
~
~D10
~H             FTN111
~D10
~MMANCHESTER UNIVERSITY  -  CONFIDENTIAL~
~
~
                                                            ISSUE 10~
~V9 -1
~P
~V9 1
~YFTN111
~S1~M~OFORTRAN 77 COMPILER IMPLEMENTATION DESCRIPTION
~S1~M~OSection 11
~S1~OSection 11. Expression Evaluation
~S1~O1.1 General Description
~BThe main function of this section is to provide procedures for
evaluation of expressions which are widely used by the semantic processing
procedures of Fortran executable statements. In addition interface
procedures concerned with code generation of a more primitive nature
are also provided, for example procedures to declare and change the
type of constants, a procedure to code the subscripts of an array reference,
a procedure to code a reference to a procedure, etc.
~BAs discussed in section 4, after Syntax analysis the analysis record
for an expression is in the form of a binary tree. Although the
expression is syntactically correct no type and compatibility checking
of operands and operators is done during syntax analysis. Furthermore
during semantic processing additional checks requiring further
information about the expression, are needed before code for the
expression is generated. Therefore expression evaluation is handled
in two distinct phase, expression reduction and expression coding.
REDUCE.EXPR performs the reduction and its functions are~
~
~M1) Adds type and operand information to the expression
~
~N2) Checks compatibility of operands and operators i.e. type checking
~
~N3) Handles any implicit declarations required
~
~N4) Evaluates constant sub-expressions.
~
REDUCE.EXPR yields as a result information about the type and the
kind of operands contained in the expression. After reduction of an
expression its context is checked where necessary by the
semantic procedures of other sections.
~BThe procedure CODE.EXPR codes a reduced expression.
~S1~O1.2 Non Standard Features
~BWhen bit 14 of the compiler mode parameter is set this activates a
non-standard option in the compiler that relaxes the strict argument
type and kind checking between actual and dummy arguments of a subprogram. If
the dummy argument is of type REAL, INTEGER or LOGICAL the actual
argument can be either of REAL, INTEGER or LOGICAL and if the dummy
argument is of type DOUBLE PRECISION or COMPLEX the actual argument
can be either of DOUBLE PRECISION or COMPLEX.
The relaxed kind checking permits an array name actual argument
for a scalar variable dummy argument and vice-versa.
~S1~O2. Interfaces
~S1~O2.1 Interfaces Used
~
   Section 1 : (Configuration Section)~
   Section 2 : (Statement Driver)~
   Section 4 : (Syntax Analysis)~
   Section 6 : (Specification Part Declarations)~
   Section 12: (Property Lists Management)~
   Section 13: (Fauly Monitoring)~
~S1~O2.2 Section Interface
~
Exported Scalars:~
   A.AP.G~
   B.AP.G~
   T.AP.G~
   CUR.A.TYPE.G~
   RL.G~
   RR.G~
   DPL.G~
   DPR.G~
   RCL.G~
   ICL.G~
   RCR.G~
   ICR.G~
~
Exported Procedures:~
   CHANGE.CONST.TYPE~
   REDUCE.EXPR~
   CODE.EXPR~
   CODE.SUBSCRIPTS~
   CODE.PROC.CALL~
   SET.A.TYPE~
   EVAL.CONST.EXPR~
   COPY.CONST~
   DECL.ARITH.CONST~
   PL.ARITH.FN~
   PL.LOAD.STR~
   CHECK.EXPR~
   CREATE.CHAR.EXPR.DUMP~
   PL.STK.LB~
   PL.VAR.OP~
   PL.STK.PAR~
~S1~O3. Implementation
~S1~O3.1 Outline of operation
~BAll TYPE parameters within this section are as encoded as~
~
~M0 - REAL, 1 - DOUBLE, PRECISION, 2 - COMPLEX,~
~N3 - INTEGER, 4 - LOGICAL, 5 - CHARACTER~
~S1~O3.1.1 REDUCE.EXPR(EXPR.INDEX)EXPR.INFO
~BThis procedure performs expression reduction on an expression within
the analysis record stack AS. The reduction action is as outlined in
the general introduction to this section.~
~BAny faults detailed are reported within this procedure and
EXPR.INFO is then set to -1.~
~3
~T# 8
~
~MEXPR.INFO is otherwise encoded as follows~
~
#Bits  0-3  Type of expression~
#Bits  4-14 When set specifies the kind of operands present~
#           in the expression~
#Bit   4    Explicit constants~
#Bit   5    Named constants~
#Bit   6    Dummy scalar variables~
#Bit   7    Common scalar variables~
#Bit   8    Scalar variables which are neither in Common~
#           nor dummy~
#Bit   9    Array element name~
#Bit  10    Array name~
#Bit  11    Procedure reference, (ie function, subroutines,~
#           intrinsic or statement function)~
#Bit  12    Procedure name~
#Bit  13    Label~
#Bit  14    Substring~
~0
~BA recursive technique is used to perform the expression reduction.
The procedure TYPE.NODE adds type and operand information to a
node in a expression tree. If the node being typed by TYPE.NODE
is a terminal node then TYPE.TERMINAL.NODE is called to type
the node, otherwise TYPE.NODE is called recursively to type the two
subsequent nodes, on returning checks are performed to ensure that the
types and kinds of operands being coerced by the operator are valid.
~BIf both subsequent nodes are constants then normally the operands
are coerced at compile time the node made into a terminal node. Finally
the node is updated with type and operand information. Thus every
terminal node of the expression three is processed by TYPE.TERMINAL.NODE.
~BBesides updating the terminal node with type and operand information
TYPE.TERMINAL.NODE deals with implicit declarations of variables,
functions and subroutines. Furthermore it processes any intrinsic
function references.
~BA variable called EXPR.TYPE global to TYPE.NODE and TYPE.TERMINAL.NODE
but local to REDUCE.EXPR maintains the kinds of operands encountered
in the expression.
~BThe following points are worthy of mentioning in determining the nature of an
operand.~
~3
~T# 6
~
   a)
~IIf an entity is referenced and it is undefined and it has no argument list
it is implicitly declared to be a scalar~
~
   b)
~IAn array reference to an undeclared array causes the array to be declared.~
~
   c)
~IIf an entity is referenced and it is defined and it has an argument list,
then it is not an intrinsic this implicitly defines a function. An
argument vector is created and a MUTL procedure specification given
for it.~
~
   d)
~IIf there is an intrinsic function reference, then selection of a specific
version of the function is required if the intrinic specified is
generic~
~
   e)
~IIf an intrinsic function name is passed as an argument, then within
the code is planted a version of the function which has reference
arguments instead of the normal value arguments of an intrinsic function.~
~0
~S1~O3.1.2 CODE.EXPR(EXPR.NODE.INDEX,REGISTER)
~BThis procedure codes an already reduced expression. Note also as
coding progresses the expression tree is modified. For efficiency
reasons the coding of a logical expression may leave information in
the T register rather than in the A register, in which case the result
is set.~
~3
~T# 20
~
EXPR.INDEX~IIndex into AS of expression tree~
~
REGISTER  %02~IEvaluate in B register. Arithmetic expressions only~
          %22~IEvaluate in A register. Arithmetic expression only~
          %20~IEvaluate expression as a sequence of LHS= MUTL
functions. Character expressions only.~
          %21~IEvaluate expression as a sequence of RHS= MUTL
functions. Character expressions only.~
          %60~IEvaluate expression leaving in A a pointer to it.
Character expressions only.~
~
TEST.INFO~IA value >0 indicates information left in T
register. It specifies what states of T yield a
value of true for the logical expression just coded.~
#1 = ,2 /= ,3 > or = ,~
#4 < ,5 = or <, 6 >~
~0
~BWhen the expression node to be coded is a terminal node, then code
to load the operand into the appropriate register is planted.
Non-terminal nodes are coded depending on the operator, the following
types of nodes are distinguished.~
~3
~
          Assignment,~
          Character Concatenation,~
          Character Compare,~
          Exporention, and~
          Other nodes.~
~0
~
The above plant code to coerce the operands of the two subservient nodes.
When a subservient node is a non-terminal node then the CODE.EXPR is called
recursively to code the node.
~S1~O3.1.3 CODE.SUBSCRIPTS(ARRAY.PROP^,SUBSCRIPT.LIST.INDEX,FLAG)
~BThe procedure evaluates the subscript for an array element name
reference and either plants code to evaluate the subscript in the B
register or yields the subscript value as a result.~
~BThe expression trees for the subscript are reduced within this
procedure and some optimisation to remove unnecessary run time constant
evaluation is performed.~
~BAny faults are reported within this procedure in which case a result
of -1 is yielded.~
~T# 18
~
ARRAY.PROP^~ILocal property pointer for the array.~
~
SUBSCRIPT.INDEX~IIndex into the analysis record to the subscript
list analysis record, which consists of a count of
the number of expressions in the subscript list
followed by that number of pointer to expression
trees.~
~
FLAG~IA value of zero means evaluate the subscript in
the B register. A value of one means the subscript
should be reducable to a constant, if not then it
is a fault. The constant subscript value is
returned as a result.~
~BMulti-dimension arrays in Fortran are mapped into arrays of one dimension
in MUTL. The usual method of calculating the subscript required is
employed. For an array with a declarator of A (L}1{:U}1{:,L}2{:U}2{,L}3{:U}3{)
and an array element reference of A (i,j,k) the array declared to MUTL
will have:~
~3
~
          (U}1{-L}1{+1)*(U}2{-L}2{+1)*(U}3{-L}3{+1) elements.~
~
And A(i,j,k) accessed as:~
~
~MA((((k-L}3{)*(U}2{-L}2{+1)+(j-L}2{))*(U}1{-L}1{+1)+(i-L}1{).
~0
~BOptimisation is employed so that all constant components of the expression
are not coded but added at the end of the calculation. This is achieved
in two ways. Firtly by determining at compile the effect of subtracting a
constant lower bound. Secondly by scanning the expression tree and removing
constants from the expression and determining the effect of the constant
at compile time.~
~S1~O3.1.4 CHANGE.CONST.TYPE(CONST.P,OLD.TYPE,NEW.TYPE)~
~BThis procedure converts the constant in the constant entry at
CONST.P from a constant of OLD.TYPE to a constant of NEW.TYPE.~
~S1~O3.1.5 CODE.PROC.CALL(EXPR.INDEX)~
~BThis procedure plants code for calling a procedure. It is used to call
functions, subroutines, statement functions and subroutines.~
~BThe expression trees for the argument lists are reduced within this
procedure.~
~S1~O3.1.6 SET.A.TYPE(TYPE)~
~BThis procedure plants the MUTL instruction AMODE = or A CONV, unless the
required mode of the A register is in effect. Bits 0-2 of TYPE specify
the Fortran type, and bit 3=1 means A contains a pointer to this type.
A one in bit 4 means plant ACONV.~
~S1~O3.1.7 EVAL.CONST.EXPR(EXPR.INDEX.REQUIRED.TYPE)CONST.P~
~BThis procedure performs reduction on the expression and monitors a
fault if this does not yield a constant of the required or a
compatible type. The constant yielded is converted to the required
type where necessary.~
~T# 14
~
EXPR.INDEX~IIndex into analysis record stack of expression.~
~
EXPR.TYPE~IBits 0-2 encoded as a 'Fortran type'. Bit 3 A value
of zero means if the requested constant
type is compatible with the expression type, then the
constant is to be converted. A value of one means the
expression must be of identical type.~
~
CONST.P~IPointer to constant entry. A nil value indicates a
fault was deleted and monitored.~
~S1~O3.1.8 COPY.CONST(CONST.P,SPACE)CONST.P~
~BThis procedure creates a constant entry in the required SPACE and
copies the contents of the constant entry pointed to by the
first parameter into it, and yields as a result the pointer of the new
entry.~
~
SPACE~IA value of zero means create the new entry in the
LINE.SPACE, otherwise create it in the LOCAL.SPACE.~
~S1~O3.1.9 DECL.ARITH.CONST(CONST.P,TYPE)MUTL.NAME~
~BThis procedure declares the constant as a literal to MUTL and yields
as a result the MUTL.NAME to access it.~
~
CONST.P~IPointer of constant entry.~
~
TYPE~IBits 0-3 Fortran type, in addition a value of 5 means
declare literal for real part of complex constant, and 6 means
declare literal for imaginary part.~
~IBit 4 A value of zero means wherever possible declare the
constant as a current literal. A value of one means a MUTL name
is to be allocated.~
~S1~O3.1.10 DECL.CHAR.CONST(CONST.ADDR)MUTL.NAME~
~BThis procedure declares a character constant to MUTL and yields the
MUTL name allocated.~
~S1~O3.1.11 PL.ARITH.FN(FUNCTION,OPERAND.INDEX)~
~BThis procedure plants code to apply to an arithmetic function to the
operand. Code to access the operand is generated where necessary. The
operand must be a terminal node of an expression tree which has
previously been reduced.~
~
FUNCTION~IMUTL function.~
~
OPERAND.INDEX~IIndex into analysis record of a terminal node of an
expression free.~
~S1~O3.1.12 PL.LOAD.STR(FUNCTION,OPERAND.INDEX)~
~BThis procedure is similar to PL.ARITH.FN, that the function is
a character function, bits 0 to 6 specify the MUTL function (%20 LHS=,
%21 RHS=, otherwise D=), in addition bit 7 is set if the reference is
unbounded.~
~S1~O3.1.13 CHECK.EXPR(EXPR.INDEX)EXPR.INFO~
~BDuring the processing of array declarations in Section 5 any
adjustable bounds can not be evaluated until the end of the
specification part. This procedure exists therefore to scan an
expression tree and yield whether it contains only constants.~
~
EXPR.INDEX~IIndex into analysis record of expression tree.~
~
EXPR.INFO~IA value of zero means that the expression only
contains constants, otherwise the result is a one.~
~S1~O3.1.14 CREATE.CHAR.EXPR.DUMP(EXPR.INDEX)MUTL.NAME~
~BThis procedure declares a character variable of the appropriate size
and plants code to copy the value of a character expression into it.~
~BThis procedure is used when the output list items of a WRITE or
PRINT statement is a character expression or when the actual argument
to a function or subroutine is a character expression.~
~
EXPR.INDEX~IIndex into analysis record of character expression.~
~
MUTL.NAME~IMUTL name alocated to character variable.~
~S1~O3.1.15 PL.STK.LB(FINDN.ID)~
~BThis procedure plants a STK.LB to the library procedure specified.~
~S1~O3.1.16 PL.VAR.OP(OP,VAR)~
~BThis procedure plants an access to a variable which may be a dummy
argument.~
~S1~O3.1.17 PL.STK.PAR(LIT)~
~BThis procedure plants a literal procedure parameter.~
~Y
~V9 -1
~P
~D15
~HFLOWCHARTS
~
~
~H                FTN111
~V9 -1
~F
@TITLE FTN11(1,10)
@COL 1S-2R-4R-5R-7R-9F
@FLOW 1-2-4-5-7-9
@BOX 1.0

23-MAR-83 (BCT) Bug fixes for validation suite+ANSYS
15-MAR-83 (BCT) Code freeze, first release at CV
28-MAR-83 (BCT) Tape sent to Manchester

EXPRESSION PROCESSING
@BOX 2.0
[IMPORTS FTN11/1]
MODULE HEADING
@BOX 4.0
LITERAL DECLARATIONS
[DATAVECS FOR CODE GENERATION FTN11.0]
@BOX 5.0
SCALAR DECLARATIONS
@BOX 7.0
PROCEDURES IN MODULE
   CHANGE.CONSTANT.TYPE:11.1:
   REDUCE.EXPR:11.2:
   CODE.EXPR:11.3:
   CODE.SUBSCRIPTS:11.4:
   CODE.PROC.CALL:11.5:
   SET.A.TYPE:11.6:
   EVAL.CONST.EXPR:11.7:
   COPY.CONSTANT : 11.8:
   DECLARE ARITH CONST:11.9:
   DECLARE CHAR CONST:11.10:
   PLANT ARITH FN:11.11:
   PLANT LOAD STR:11.12:
   CALC.CHAR.EXPR.LENGTH:11.13:
   CHECK.CONSTANT:11.14:
   LOAD.A.FROM.T:11.15:
   CHECK.EXPR:11.17:
   CREATE.CHAR.EXPR.DUMP:11.19:
   LOAD.REGS.FOR.CHAR.ARRAY.EL.NODE:11.20:
   LOAD.REGS.FOR.CHAR.ARRAY.EL.REFN:11.21:
   PL.STK.LB:11.22:
   PL.VAR.OP:11.23:
   PL.STK.PAR:11.24:
   STR.SIZE:11.25:
   PR.HOLLERITH:11.26:
   PR.TYPELESS:11.27:
   SET.B.TYPE:11.28:
   INT.CONST.PR:11.29:
@BOX 9.0
END
@BOX 2.1
#FTN11/1
;MODULE(A.AP.G,B.AP.G,T.AP.G,CUR.A.TYPE.G,C.FTN.TYPE.G,C.FTN.PR.G,
        R.L.G,RR.G,DPL.G,DPR.G,RCL.G,ICL.G,RCR.G,ICR.G,
        CHECK.EXPR,CHANGE.CONST.TYPE,REDUCE.EXPR,CODE.EXPR,
        CODE.SUBSCRIPTS,CODE.PROC.CALL,SET.A.TYPE,
        EVAL.CONST.EXPR,COPY.CONST,DECL.ARITH.CONST,
        DECL.CHAR.CONST,PL.LOAD.STR,PL.ARITH.FN,PL.STK.PAR,
        CREATE.CHAR.EXPR.DUMP,LOAD.REGS.FOR.CHAR.ARRAY.EL.NODE,
        LOAD.REGS.FOR.CHAR.ARRAY.EL.REFN,PL.STK.LB,PL.VAR.OP,
        SET.B.TYPE, MIN.IND.Z.G, MIN.INTR.Z.G,RW.PROCS);
@BOX 4.1
; *GLOBAL 7
#FTN11.0
@BOX 5.1
; *GLOBAL 2
;$IN A.AP.G, B.AP.G, T.AP.G, CUR.A.TYPE.G, CUR.A.DIM.G, MIN.INTR.Z.G
;$IN C.FTN.TYPE.G, C.FTN.PR.G
;$IN EXPR.TYPE, CHAR.DUMP.LENGTH, CUR.B.TYPE.G, MIN.IND.Z.G, CUR.FN.EX.G
;$RE32 R.L.G, RR.G, RCL.G, ICL.G, RCR.G, ICR.G
;$RE64 DPL.G, DPR.G
; $IN16[NO.FIO.PROCS.L] RW.PROCS
; *GLOBAL 7
; DATAVEC AMODE($LO16)
%00 %00 %108 %40
%80 %83 %83 %40
%01 %01 %109 %41
%81 %83
END
;DATAVEC DEF.PR($LO8)
2 3 3 2 2 0 4 8
END
; *GLOBAL 0
@BOX 7.1
;P.SPEC CHECK.EXPR($IN)/$IN
;P.SPEC CHANGE.CONST.TYPE(ADDR CONST.PROP,$IN,$IN)
;P.SPEC REDUCE.EXPR($IN)/$IN
;P.SPEC CODE.EXPR($IN,$IN)/$IN
;P.SPEC CODE.SUBSCRIPTS($IN,$IN,$IN)/$IN
;P.SPEC CODE.PROC.CALL($IN)
;P.SPEC SET.A.TYPE($IN,$IN)
;P.SPEC EVAL.CONST.EXPR($IN,$IN)/ADDR CONST.PROP
;P.SPEC COPY.CONST(ADDR CONST.PROP,$IN)/ADDR CONST.PROP
;P.SPEC DECL.ARITH.CONST(ADDR CONST.PROP,$IN)/$IN
;P.SPEC DECL.CHAR.CONST($IN)/$IN
;P.SPEC PL.LOAD.STR($IN,$IN)
;P.SPEC PL.ARITH.FN($IN,$IN)
;P.SPEC CREATE.CHAR.EXPR.DUMP($IN)/$IN
;P.SPEC LOAD.REGS.FOR.CHAR.ARRAY.EL.NODE($IN)
;P.SPEC LOAD.REGS.FOR.CHAR.ARRAY.EL.REFN(ADDR LOCAL.PROP)
;P.SPEC PL.STK.LB($LO8,$IN)
;P.SPEC PL.VAR.OP($IN,ADDR LOCAL.PROP)
;P.SPEC CALC.CHAR.EXPR.LENGTH($IN)/$IN
;P.SPEC CHECK.CONST($IN,$IN,$IN)/$IN
;P.SPEC LOAD.A.FROM.T()
;P.SPEC PL.STK.PAR($IN)
;P.SPEC STR.SIZE($IN)/$IN
;P.SPEC PR.HOLLERITH($IN, $IN,$IN)
;P.SPEC PR.TYPELESS($IN,$IN,$IN)
;P.SPEC SET.B.TYPE($IN)
;P.SPEC CONST.PRECISION(ADDR CONST.PROP, $IN)/$IN
#FTN11.1
#FTN11.2
#FTN11.3
#FTN11.4
#FTN11.5
#FTN11.6
#FTN11.7
#FTN11.8
#FTN11.9
#FTN11.10
#FTN11.11
#FTN11.12
#FTN11.13
#FTN11.14
#FTN11.15
#FTN11.17
#FTN11.19
#FTN11.20
#FTN11.21
#FTN11.22
#FTN11.23
#FTN11.24
#FTN11.25
#FTN11.26
#FTN11.27
#FTN11.28
#FTN11.29
@BOX 9.1
;*END
@END
@TITLE FTN11/1(1,11)
@COL 1S-2R
@COL 3R-4R-5R-6R-7F
@FLOW 1-2-3-4-5-6-7
@BOX 1.0
EXPRESSION IMPORTS
@BOX 2.0
IMPORTED TYPES
@BOX 3.0
IMPORTED LITERALS
@BOX 4.0
IMPORTED SCALARS
@BOX 5.0
IMPORTED VECTORS
@BOX 6.0
IMPORTED PROCEDURES
@BOX 7.0
END
@BOX 2.1
;IMPORT TYPE EQUIV.PROP
;TYPE NAME.T IS $AD[$LO8] NAME :: ??? JM 27-DEC-82
;TYPE PROPS;
;TYPE CONST.PROP;
;TYPE LOCAL.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 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
;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
@BOX 3.1
;IMPORT LITERAL AS.Z.L,PROPS.Z.L,I.ACC.T.L,BASE.OP.L,STR.ARR.BASE.OP.L,
     LINE.SPACE,LOCAL.SPACE,GLOBAL.SPACE,D.ARG.TYPE.L,C.COMP.ACC.T.L,
     NO.FIO.PROCS.L
;IMPORT LITERAL $LO8 SPACE.L
@BOX 4.1
;$LO16 TL.ONE.G,TL.ZERO.G,PSPECN.G
;$IN FMT.DICT.TYPE.G,MUTLN.G,END.AP.G,PSPEC.CNT,L.ACC.Z.G
;ADDR LOCAL.PROP F.L.PROP.G
;$IN32 F.I.G
;$IN PROPS.I, VAL.ARG.Z.G, I.ACC.Z.G
;LABEL ABORT.COMPILE
@BOX 5.1
;$IN[AS.Z.L] AS
; PROPS[PROPS.Z.L] PROPS.T
; $LO8[7] PR.T
; $LO16[7] MODE
@BOX 6.1
;P.SPEC CHECK.SPECS(ADDR[$LO8],ADDR[$LO8])/$IN
;P.SPEC DECLARE.PROC.SPEC(ADDR[$LO8],$IN,ADDR[$LO8])/$IN
;P.SPEC CHECK.IMPLICIT.DECL(ADDR LOCAL.PROP)/$IN
;P.SPEC MUTL.TYPE($IN, $IN)/$IN
;P.SPEC V.DECL($IN, $IN, $IN)/$IN
;P.SPEC ADD.G.NAME(ADDR NAME.T)/ADDR GLOBAL.PROP
;P.SPEC LOOK.UP.INTRINSIC(ADDR LOCAL.PROP)/$IN
;P.SPEC FAULT($IN,$IN)
;P.SPEC MAKE.LO8($IN,$IN)/ADDR [$LO8]
;P.SPEC MAKE.CONST.PROP($IN)/ADDR CONST.PROP    ::FTN12
;P.SPEC MAKE.LOCAL.PROP($IN)/ADDR LOCAL.PROP
;L.SPEC FIND.N(ADDR[$LO8],$IN)/$LO32
::CV ;P.SPEC FIND.N(ADDR[$LO8],$IN)/$LO32
;L.SPEC FIND.P($LO32,$IN,$IN)/$IN
::CV ;L.SPEC FIND.P($LO32,$IN,$IN)/$IN
;L.SPEC TL.PROC.SPEC(ADDR[$LO8],$IN)
;L.SPEC TL.PROC.PARAM($IN,ADDR)
;L.SPEC TL.PROC.RESULT($IN)
;L.SPEC TL.PARAM.NAME($IN,ADDR[$LO8])
;L.SPEC TL.PROC.KIND($IN)
;L.SPEC TL.PROC($IN)
;L.SPEC TL.SET.TYPE($IN,$IN)
;L.SPEC TL.PL($IN,$IN)
;L.SPEC TL.END.PROC()
;L.SPEC TL.S.DECL(ADDR[$LO8],$IN,ADDR)
;L.SPEC TL.C.LIT.16($IN, $IN16)
;L.SPEC TL.C.LIT.32($IN,$IN32)
;L.SPEC TL.C.LIT.64($IN,$LO64)
;L.SPEC TL.LABEL.SPEC(ADDR[$LO8], $IN)
;L.SPEC TL.LABEL($IN)
;L.SPEC TL.BLOCK()
;L.SPEC TL.END.BLOCK()
;L.SPEC TL.LIT(ADDR[$LO8],$IN)
;L.SPEC TL.ASS($IN,$IN)
;L.SPEC TL.ASS.VALUE($IN,$IN)
;L.SPEC TL.ASS.END()
;L.SPEC TL.C.LIT.S($IN,ADDR[$LO8])
;L.SPEC TL.REG($IN)
;L.SPEC TL.I.PARAM($IN, $IN, $IN)
@END

@TITLE FTN11.0(1,6)
@COL 1S-2R-3R-5R-4F
@FLOW 1-2-3-5-4
@BOX 1.0
MISC DATAVECS FOR CODE GENERATION
@BOX 2.0
MISC DATAVECS
EXCEPT INTRINSIC DATAVEC
@BOX 3.0
INTRINSIC DATAVECS
INTR INF0:11.0.1:
GENERIC INTR:11.0.2:
SELECT SPECIFIC INTR:11.0.3:
INTR MUTL FN CODE:11.0.4:
INTR ARG SPECIFICATIONS:11.0.5:
@BOX 5.0
DATAVECS FOR IO ROUTINE NAMES:11.0.6:
@BOX 4.0
END
@BOX 1.1
@BOX 2.1
;DATAVEC REV.FN($LO8)
0 1 2 3
4 5 6 7
8 10 9 11
13 12 14 15
END
;DATAVEC REV.REL($LO8)
%20 %40 %A0 %C0
%60 %80
END
;DATAVEC TL.REL.T.FN($LO16)
0 %1008 %1009 %100A
%100D %100C %100B
END
;DATAVEC RANK($LO8)
::INDEXED BY OP1 * 5 + OP2
:: 0 - OP2 OF HIGHER RANK (PRECISION)
:: 1 - OP1 OF HIGHER OR EQUAL RANK
:: 2 - OP1 AS SAME RANK AS OP2
::     EXAMINE PRECISION TO DECIDE RANK
0 1 1 0 0
0 0 0 0 0
0 0 0 0 0
1 1 1 2 0
0 0 0 0 2
END
@BOX 3.1
#FTN11.0.1
#FTN11.0.2
#FTN11.0.3
#FTN11.0.4
#FTN11.0.5
@BOX 5.1
#FTN11.0.6
@BOX 4.1
@END
@TITLE FTN11.0.1(1,6)
@COL 1S
@BOX 1.0
INTR INFO DATAVEC
@BOX 1.1
;DATAVEC INTR.INFO($LO8)
%C0  %80  %81  %82  0    0    %D0  %83
0    %84  %85  %86  %C1  %E3  %C3  %E5
%C5  %C6  %C7  0    %CB  %DF  %E0  %CF
%80  %80  %80  %81  %81  %88  %82  %82
%89  %89  %8A  %8A  %8B  %83  %83  %8C
%8C  %8C  %84  %84  %85  %85  %86  %8D
%92  %8E  %8F  %90  %87  %CA  %C9  %DD
%DE  %88  %88  %E9  %89  %89  %89  %8A

%8A  %E7  %CD  %91  %8B  %8B  0    %8D
%92  %8E  %93  %8F  %90  %87  %E1  %8A
0    %CE  %94  %94  %93  %52  %53  %54
%55  %56  %57  %58  %51  %59  %62  %5B
%5B  %6B  %6D  %6D
END
::INDEXED BY INTR.NO
::BIT 7=1 MEANS NAME IS A SPECIFIC INTRINSIC
::BIT 6=1 SPECIFIC INTRINSIC WHICH PRODUCES INLINE CODE
::        BITS 0-5 INLINE CODE SEQUENCE NO
::BIT 6=0 SPECIFIC INTRINSIC WHICH USE MFN OF MUTL
::        BITS 0-5 GIVE MUTL.FN.IND
@END

@TITLE FTN11.0.2(1,10)
@COL 1S
@BOX 1.0
GENERIC INTRINSIC DATAVEC
@BOX 1.1
;DATAVEC GEN.INTR($LO8)
%0 %1  %2  %3  %4 %5 %FF %86
%87 %88 %89 %8A %7F %7F %7F %7F
%7F %18 %7F %19 %7F %8B %FF %8C
%FF %FF %FF %FF %FF %8D %FF %FF
%7F %7F %7F %7F %8E %FF %FF %FF
%FF %FF %FF %FF %FF %FF %FF %8F
%90 %91 %92 %93 %94 %7F %7F %95
%FF %FF %FF %FF %7F %7F %7F %7F
%7F %FF %FF %FF %FF %FF %16 %FF
%FF %FF %97 %FF %FF %FF %7F %FF
%1A %FF %FF %FF %FF
END
::INDEXED BY INTR.NO
::BIT 7= 1 MEANS INTR IS SPECIFIC AND IT IS ALLOWED AS AN ACTUAL ARGUMENT
::BITS 0 - 6 CONTAIN GEN INTR FOR ACCESSING SEL SPEC INTR
::%7F INDICATES NAME MAY NOT BE USED GENERICALLY
@END
@TITLE FTN11.0.3(1,10)
@COL 1S
@BOX 1.0
SELECT SPECIFIC INTRINSIC DATAVEC
@BOX 1.1
;DATAVEC SEL.SPEC.INTR($LO8)
0   78  92  85
1   25  26  24
27  28  %FF 2
3   31  %FF 30
60  61  %FF 32
63  64  %FF 34
7   37  38  %FF
39  40  41  %FF
9   42  43  %FF
10   44  45  %FF
11  46  %FF %FF
21  22  %FF %FF
23  81  %FF %FF
29  58  %FF 57
36  68  69  %FF
47  71  %FF %FF
48  72  %FF %FF
49  73  %FF %FF
50  75  %FF %FF
51  76  %FF %FF
52  77  %FF %FF
55  56  %FF %FF
82  83  %FF %FF
74  84  %FF %FF
86  18  87  17
88  89  90  91
93  94  95  96
97 98 %FF 99
END
::%FF MEANS NO SPECIFIC VERSION OF GENERIC FN
::INDEXED BY GEN INTR NO * 4 + TYPE
::ELEMENTS GIVE INTR.NO
@END

@TITLE FTN11.0.4(1,6)
@COL 1S
@BOX 1.0
INTRINSIC MUTL CODE SEQUENCES
@BOX 1.1
;DATAVEC INTR.TL.FN($LO8)
0   0   0
1   0   2
5   0   6
17  0   0
14  0   0
15  0   0
19  0   0
27  0   0
3   0   4
7   8   %89
10  11  %8C
13  0   0
16  0   0
20  0   0
22  0   0
25  0   0
26  0   0
1   0   0
21  0   0
23  24  24
18  0   0
END
::FIRST ITEM OF TRIPLET GIVES MUTL FN FOR FIRST ARGUMENT
::SEC ITEM GIVES MUTL FN FOR ALL MIDDLE ARGUMENTS
::THIRD ITEM GIVES MUTL FOR LAST ARGUMENT IF MORE THAN ONE
::IF BIT 7 = 1 THEN IF FUNCTION AND ARGUMENT ARE OF DIFFERENT TYPE
::THEN PLANT A CONV TO FUNCTION TYPE
@END
@TITLE FTN11.0.5(1,6)
@COL 1S-2R
@COL 3R-4F
@FLOW 1-2-3-4
@BOX 1.0
INTRINSIC ARG SPECIFICATION DATAVECS
@BOX 1.1
:: INDEXED BY INTR.NO * 7
;LITERAL INTR.ARG.STRIDE=2 :: ??? JM 24-JAN-83
DATAVEC INTR.ARG.SPECS($LO8)
@BOX 2.1
3 %20 %20 2   %FF  0 0
0 2 %20 2   %FF  0 0
3 %20 %23 %20 %23 %20   %FF
0 2 %20 2 %20 2   %FF
%FF %FF %FF %FF %FF %FF %FF
%FF %FF %FF %FF %FF %FF %FF
3 %20 %2D 0   %FF %FF 0
0 2 %20 2   %FF %FF 0

%FF %FF %FF %FF %FF %FF %FF
0 2 %20 2   %FF %FF 0
0 2 %20 2   %FF %FF 0
0 2 %20 2   %FF %FF 0
4 0 %2D 0  %2D 0   %FF
4 0 %2D 0  %2D 0   %FF
4 0 %2D 0  %2D 0   %FF
4 0 %2D 0  %2D 0   %FF

3 %20 %20 2   %FF %FF 0
0 2 %23 %20   %FF %FF 0
0 2 %21 3   %FF %FF 0
%FF %FF %FF %FF %FF %FF %FF
5 0 %23 %20   %FF %FF 0
0 2 %20 2   %FF %FF 0
1 3 %21 3   %FF %FF 0
3 %20 %20 2  %FF %FF 0

3 %20 %23 %20   %FF %FF 0
1 3 %21 3   %FF %FF 0
0 2 %22 3   %FF %FF 0
0 2 %20 2 %20 2   %FF
1 3 %21 3 %21 3   %FF
0 2 %20 2 %20 2   %FF
3 %20 %23 %20 %23 %20   %FF
1 3 %21 3 %21 3   %FF

3 %20 %23 %20 %23 %20   %FE
3 %20 %20 2 %20 2   %FE
3 %20 %23 %20 %23 %20   %FE
3 %20 %20 2 %20 2   %FE
0 2 %20 2   %FF %FF 0
1 3 %21 3   %FF %FF 0
2 3 %22 3   %FF %FF 0
0 2 %20 2   %FF %FF 0

1 3 %21 3   %FF %FF 0
2 3 %22 3   %FF %FF 0
1 3 %21 3   %FF %FF 0
2 3 %22 3   %FF %FF 0
1 3 %21 3   %FF %FF 0
2 3 %22 3   %FF %FF 0
1 3 %21 3   %FF %FF 0
0 2 %20 2   %FF %FF 0
@BOX 3.1
0 2 %20 2   %FF %FF 0
0 2 %20 2   %FF %FF 0
0 2 %20 2   %FF %FF 0
0 2 %20 2   %FF %FF 0
0 2 %20 2   %FF %FF 0
0 2 %23 %20   %FF %FF 0
3 %20 %2D 0   %FF %FF 0
0 2 %20 2   %FF %FF 0

1 3 %21 3   %FF %FF 0
3 %20 %23 %20 %23 %20   %FF
1 3 %21 3 %21 3   %FF
1 3 %20 2 %20 2   %FF
0 2 %20 2 %20 2   %FE
1 3 %21 3 %21 3   %FE
0 2 %23 %20 %23 %20   %FE
0 2 %20 2 %20 2   %FE

1 3 %21 3 %21 3   %FE
3 %20 %2D 0   %2D 0 %FF
0 2 %22 3   %FF %FF 0
2 3 %22 3   %FF %FF 0
1 3 %21 3   %FF %FF 0
2 3 %22 3   %FF %FF 0
%FF %FF %FF %FF %FF %FF %FF
1 3 %21 3   %FF %FF 0

1 3 %21 3   %FF %FF 0
1 3 %21 3   %FF %FF 0
0 2 %20 2 %20 2   %FF
1 3 %21 3   %FF %FF 0
1 3 %21 3   %FF %FF 0
1 3 %21 3   %FF %FF 0
3 %20 %21 3   %FF %FF 0
0 2 %23 %20 %23 %20   %FE

%FF %FF %FF %FF %FF %FF %FF
3 %20 %21 3   %FF %FF 0
0 2 %20 2   %FF %FF 0
1 3 %21 3   %FF %FF 0
1 3 %21 3 %21 3   %FF
3 %20 %23 %20   %FF %FF 0
0 2 %20 2   %FF %FF 0
0 2 %22 3   %FF %FF 0

1 3 %20 2   %FF %FF 0
1 3 %21 3   %FF %FF 0
1 3 %22 3   %FF %FF 0
1 3 %23 %20   %FF %FF 0
3 %20 %22 3   %FF %FF 0
2 3 %20 2   %FF %FF 0
2 3 %21 3   %FF %FF 0
2 3 %22 3   %FF %FF 0

2 3 %23 %20   %FF %FF 0
2 3 %20 2   %20 2 %FF
2 3 %21 3   %21 3 %FF
2 3 %23 %20   %23 %20 %FF
@BOX 4.1
END
@END
@TITLE FTN11.0.6(1,11)
@COL 1S
@FLOW 1
@BOX 1.0
DATAVECS FOR IO ROUTINE NAMES
@BOX 1.1
;DATAVEC IO.NAMES($LO8)
"FIO.RREAD" "FIO.DPREAD" "FIO.CREAD"
"FIO.I8.READ" "FIO.I16.READ" "FIO.I32.READ"
"FIO.L8.READ" "FIO.L16.READ" "FIO.L32.READ" "FIO.STRREAD"
"FIO.UF.R.READ" "FIO.UF.DP.READ" "FIO.UF.C.READ"
"FIO.UF.I8.READ" "FIO.UF.I16.READ" "FIO.UF.I32.READ"
"FIO.UF.L8.READ" "FIO.UF.L16.READ" "FIO.UF.L32.READ" "FIO.UF.STRREAD"
"FIO.LDRREAD" "FIO.LDDPREAD" "FIO.LDCREAD"
"FIO.LD.I8.READ" "FIO.LD.I16.READ" "FIO.LD.I32.READ"
"FIO.LD.L8.READ" "FIO.LD.L16.READ" "FIO.LD.L32.READ" "FIO.LD.STRREAD"
"FIO.RWRITE" "FIO.DPWRITE" "FIO.CWRITE"
"FIO.I8.WRITE" "FIO.I16.WRITE" "FIO.I32.WRITE"
"FIO.L8.WRITE" "FIO.L16.WRITE" "FIO.L32.WRITE" "FIO.STRWRITE"
"FIO.UF.R.WRITE" "FIO.UF.DP.WRITE" "FIO.UF.C.WRITE"
"FIO.UF.I8.WRITE" "FIO.UF.I16.WRITE" "FIO.UF.I32.WRITE"
"FIO.UF.L8.WRITE" "FIO.UF.L16.WRITE" "FIO.UF.L32.WRITE" "FIO.UF.STRWRITE"
"FIO.LDRWRITE" "FIO.LDDPWRITE" "FIO.LDCWRITE"
"FIO.LDIWRITE" "FIO.LDIWRITE" "FIO.LDIWRITE"
"FIO.LDLWRITE" "FIO.LDLWRITE" "FIO.LDLWRITE" "FIO.LDSTRWRITE"
"FIO.INQUIRE.EXIST" "FIO.INQUIRE.OPENED" "FIO.INQUIRE.NUMBER"
"FIO.INQUIRE.NAMED" "FIO.INQUIRE.NAME" "FIO.INQUIRE.ACCESS"
"FIO.INQUIRE.SEQUENTIAL" "FIO.INQUIRE.DIRECT" "FIO.INQUIRE.FORMATTED"
"FIO.INQUIRE.FORM" "FIO.INQUIRE.UNFORMATTED" "FIO.INQUIRE.RECL"
"FIO.INQUIRE.NEXT.REC" "FIO.INQUIRE.BLANK" "FIO.INQUIRE"
"FIO.EREAD" "FIO.EWRITE"
"FIO.SELECT.DA.UNIT" "FIO.SELECT.SEQ.UNIT" "FIO.SELECT.STRING"
"FIO.R.FORMAT" "FIO.SELECT.FORMAT" "FIO.SET.FLT.RESTART"
"FIO.STATUS" "FIO.INIT.RUN" "FIO.F.STP" "FIO.F.STP.CH"
"FIO.PAUSE" "FIO.PAUSE.CH" "FIO.REWIND" "FIO.BSPACE"
"FIO.ENDFILE" "FIO.OPEN" "FIO.CLOSE"
"CREATE.SEGMENT" "ENTER.TRAP"
END
;DATAVEC NAME.INDEX($IN16)
0 9 19
28 39 51
63 74 86 98
109 122 136
149 163 178
193 207 222 237
251 262 274
285 299 314
329 343 358 373
387 397 408
418 430 443
456 468 481 494
506 520 535
549 564 580
596 611 627 643
658 670 683
695 707 719
731 748 755 767
781 798 816
834 851 867
885 907 925
946 962 985
1001 1021 1038
1049 1058
1068 1086 1105
1122 1134 1151
1170 1180 1192 1201
1213 1222 1234 1244
1254 1265 1273
1282 1296 1306
END
@END
@TITLE FTN11.1(1,10)
@COL 14C-15R-16C-17C-18R-19C-20C-21R-22C-23C-24R-25C
@COL 1S-2R-38R-3C-4R-32C-5C-6R-7C-8C-9R-10C-11C-12R-13F
@COL 26C-27R-28C-29C-30R-31C-37C-33C-34C-35R-36C
@ROW 14-3-26
@FLOW 1-2
@FLOW 14-15-16
@FLOW 17-18-19
@FLOW 20-21-22
@FLOW 23-24-25
@FLOW 3-4-32
@FLOW 5-6-7
@FLOW 8-9-10
@FLOW 11-12-13
@FLOW 26-27-28
@FLOW 29-30-31
@FLOW 37-33
@FLOW 34-35-36
@BOX 1.0
CHANGE.CONST.TYPE(CONST^,OLD.TYPE,NEW.TYPE)
@BOX 2.0
SWITCH ON CONVERSION REQUIRED
@BOX 3.0
INT->DBL
@BOX 4.0
CHANGE CONSTANT
@BOX 32.0
END
@BOX 5.0
REAL->DBL
@BOX 6.0
CHANGE CONSTANT
@BOX 7.0
END
@BOX 8.0
DOUBLE->REAL
@BOX 9.0
CHANGE CONSTANT
@BOX 10.0
END
@BOX 11.0
COMPLEX->REAL
@BOX 12.0
CHANGE CONSTANT
@BOX 13.0
END
@BOX 14.0
INT->REAL
@BOX 15.0
CHANGE CONSTANT
@BOX 16.0
END
@BOX 17.0
REAL->INT
@BOX 18.0
CHANGE CONSTANT
@BOX 19.0
END
@BOX 20.0
DOUBLE->INT
@BOX 21.0
CHANGE CONSTANT
@BOX 22.0
END
@BOX 23.0
COMPLEX->INT
@BOX 24.0
CHANGE CONSTANT
@BOX 25.0
END
@BOX 26.0
INT->COMPLEX
@BOX 27.0
CHANGE CONSTANT
@BOX 28.0
END
@BOX 29.0
REAL->COMPLEX
@BOX 30.0
CHANGE CONSTANT
@BOX 31.0
END
@BOX 37.0
NIL CONVERSION
@BOX 33.0
END
@BOX 34.0
ILLEGAL
CONVERSION
@BOX 35.0
"UNEXPECTED FAULT"
@BOX 36.0
END
@BOX 38.0
FURTHER CONVERSIONS [11.1.1]
@BOX 1.1
;PROC CHANGE.CONST.TYPE(P,OT,NT)
@BOX 2.1
;IF OT = 8 THEN
   ;4 => OT
;FI
;SWITCH  OT*5 + NT\
B37, B5, B29, B17, B34,
B8, B37, B34, B20, B34,
B11, B34, B37, B23, B34,
B14, B3, B26, B37, B34,
B1.8, B1.2, B1.14, B1.11, B1.5
@BOX 3.1
;B3:
@BOX 4.1
;INT.CONST OF P^ => D.P.CONST OF P^
@BOX 32.1
;EXIT
@BOX 5.1
;B5:
@BOX 6.1
;REAL.CONST OF P^ => D.P.CONST OF P^
@BOX 7.1
;EXIT
@BOX 8.1
;B8:
@BOX 9.1
;D.P.CONST OF P^ => REAL.CONST OF P^
@BOX 10.1
;EXIT
@BOX 11.1
;B11:
@BOX 12.1
;R.COMP.CONST OF P^ => REAL.CONST OF P^
@BOX 13.1
;END
@BOX 14.1
;B14:
@BOX 15.1
;INT.CONST OF P^ => REAL.CONST OF P^
@BOX 16.1
;EXIT
@BOX 17.1
;B17:
@BOX 18.1
;REAL.CONST OF P^ => INT.CONST OF P^
@BOX 19.1
;EXIT
@BOX 20.1
;B20:
@BOX 21.1
;DP.CONST OF P^ => INT.CONST OF P^
@BOX 22.1
;EXIT
@BOX 23.1
;B23:
@BOX 24.1
;R.COMP.CONST OF P^ => INT.CONST OF P^
@BOX 25.1
;EXIT
@BOX 26.1
;B26:
@BOX 27.1
;INT.CONST OF P^ => R.COMP.CONST OF P^
;0 => I.COMP.CONST OF P^
@BOX 28.1
;EXIT
@BOX 29.1
;B29:
@BOX 30.1
;REAL.CONST OF P^ => R.COMP.CONST OF P^
;0  => I.COMP.CONST OF P^
@BOX 31.1
;EXIT
@BOX 37.1
;B37:
@BOX 33.1
;EXIT
@BOX 34.1
;B34:
@BOX 35.1
;FAULT(145,6)
@BOX 36.1
;EXIT
@BOX 38.1
#FTN11.1.1
@END
@TITLE FTN11.1.1(1,11)
@COL 8C-9R-10C-11C-12R-13C
@COL 1S-2C-3R-4C-5C-6R-7C
@COL 14C-15R-16C
@FLOW 8-9-10
@FLOW 11-12-13
@FLOW 2-3-4
@FLOW 5-6-7
@FLOW 14-15-16
@ROW 8-2-14
@BOX 1.0
FURTHER CONVERSIONS
@BOX 2.0
TYPELESS TO DP
@BOX 3.0
CHANGE CONSTANT
@BOX 4.0
END
@BOX 5.0
TYPELESS TO LOG
@BOX 6.0
CHANGE CONSTANT
@BOX 7.0
END
@BOX 8.0
TYPELESS TO REAL
@BOX 9.0
CHANGE CONSTANT
@BOX 10.0
END
@BOX 11.0
TYPELESS TO INT
@BOX 12.0
CHANGE CONSTANT
@BOX 13.0
END
@BOX 14.0
TYPELESS TO COMPLEX
@BOX 15.0
CHANGE CONSTANT
@BOX 16.0
END
@BOX 1.1
::BEGIN
@BOX 2.1
;B1.2:
@BOX 3.1
;T.CONST OF P^ => D.P.CONST OF P^
@BOX 4.1
;EXIT
@BOX 5.1
;B1.5:
@BOX 6.1
;T.CONST OF P^ => LOG.CONST OF P^
@BOX 7.1
;EXIT
@BOX 8.1
;B1.8:
@BOX 9.1
;T.CONST OF P^ => INT.CONST OF P^
@BOX 10.1
;EXIT
@BOX 11.1
;B1.11:
@BOX 12.1
;T.CONST OF P^ => INT.CONST OF P^
@BOX 13.1
;EXIT
@BOX 14.1
;B1.14:
@BOX 15.1
;T.CONST OF P^ => R.COMP.CONST OF P^
;0. => I.COMP.CONST OF P^
@BOX 16.1
;EXIT
@END
@TITLE FTN11.2(1,7)
@COL 1S-2R-3R-4R-8T-9R-10R-5F
@COL 6C-7R
@FLOW 1-2-3-4-8N-9-10-5
@FLOW 6-7-5
@FLOW 8Y-10
@ROW 6-3
@BOX 1.0
REDUCE.EXPR(EXPR.INDEX)EXPR.TYPE
@BOX 2.0
INTERNAL PROCS
TYPE TERMINAL NODE:11.16:
@BOX 6.0
REDUCE EXPR
FAULT
@BOX 7.0
SET EXPR TYPE TO -1
@BOX 3.0
RESET EXPR TYPE
@BOX 4.0
TYPE.NODE:11.16
@BOX 5.0
END
@BOX 8.0
NAME NOT A TYPELESS CONSTANT
@BOX 9.0
CHANGE MODE TO INTEGER * 4 [11.27]
@BOX 10.0
SET RESULT
@BOX 1.1
;PROC REDUCE.EXPR(AP)
;$IN DUMP
;LABEL REDUCE.EXPR.FAULT
;->XX
;FAIL:
;->B6
;XX:
FAIL=>REDUCE.EXPR.FAULT
@BOX 3.1
;EXPR.TYPE => DUMP
;0 => EXPR.TYPE
@BOX 4.1
;TYPE.NODE(AP)
@BOX 5.1
;DUMP => EXPR.TYPE
;END
@BOX 2.1
;PSPEC TYPE.NODE($IN)
#FTN11.16
@BOX 6.1
;B6:
@BOX 7.1
;-1=>REDUCE.EXPR
@BOX 8.1
;IF AS[AP] & %F01F /= %8010
@BOX 9.1
;PR.TYPELESS(AP,3,2)
@BOX 10.1
;AS[AP] ->> 12 & %F ! EXPR.TYPE => REDUCE.EXPR
@END
@TITLE FTN11.3(1,10)
@COL 1S-8T-9R-2T-3R-4F
@COL 5T-6R-7R
@ROW 2-5
@FLOW 1-8N-9-2N-3-4
@FLOW 2Y-5N-6-4
@FLOW 8Y-2
@FLOW 5Y-7-4
@BOX 1.0
CODE.EXPR(AP,LOAD.INFO)
@BOX 2.0
EXPR A SINGLE NODE?
@BOX 3.0
PROCESS NODE ACCORDING TO
OPERATOR
ASSIGNMENT NODE:11.3.1:
CONCATENATION NODE:11.3.2:
CHARACTER COMPARE NODE:11.3.3:
EXPONENTIATION NODE:11.3.4:
OTHERS NODES:11.3.5:
@BOX 4.0
END
@BOX 5.0
CHARACTER NODE?
@BOX 6.0
PL ARITH FN(LOAD):11.11:
@BOX 7.0
PL LOAD STRING(LOAD):11.12:
@BOX 8.0
B TYPE SETTING REQUIRED?
@BOX 9.0
SET B TYPE
@BOX 1.1
;PROC CODE.EXPR(AP,REG)
;$IN T,RHAP,LHAP
;$LO8 NT
;$LO16 LHT,RHT
;ADDR CONST.PROP CP
;PSPEC CODE.OP($IN,$IN,$IN,$IN,$IN)/$IN;
#FTN11.3.6
;-1 => CODE.EXPR
@BOX 2.1
;AS[AP] => T ->> 12 & 7 => NT
;IF T & %10 /= 0
@BOX 3.1
;AS[AS[AP+1] => LHAP] ->> 12 & 7 => LHT
;AS[AS[AP+2] => RHAP] ->> 12 & 7 => RHT
;IF T & %F => T = 0 THEN
#FTN11.3.1
;ELSE IF T = 1 THEN
#FTN11.3.2
;ELSE IF T = 6 THEN
#FTN11.3.4
;ELSE IF T < 15 THEN
#FTN11.3.5
;ELSE
#FTN11.3.3
;FI FI FI FI
@BOX 5.1
;IF NT = 5
@BOX 6.1
;PL.ARITH.FN(REG,AP)
@BOX 7.1
;PL.LOAD.STR(REG,AP)
@BOX 4.1
;END
@BOX 8.1
;IF REG & %100 = 0
@BOX 9.1
;%FF &> REG
;IF AS[AP] ->> 5 & 7 => T = 0 THEN
   ;1 => T
;FI
;SET.B.TYPE(T)
@END
@TITLE FTN11.3.1(1,10)
@COL 22T-11R-12R-13R-14R-15C-23R-24R
@COL 1S-2T-3T-4R-5R-6T-7R-8R-9R-10F
@COL 19T-20R-21R
@ROW 22-3
@ROW 4-19
@FLOW 1-2N-3N-4-5-6N-7-8-9-10
@FLOW 2Y-22N-11-12-13-14-15
@FLOW 22Y-23-24-9
@FLOW 3Y-19N-20-21-8
@FLOW 19Y-21
@FLOW 6Y-8
@BOX 1.0
ASSIGNMENT MODE
@BOX 2.0
CHARACTER ASSIGNMENT?
@BOX 3.0
RHS A CONSTANT?
@BOX 4.0
CODE.EXPR(RHS IN A):11.3:
@BOX 5.0
IF RESULT IN T
THEN LOAD A :11.15:
@BOX 6.0
TYPE CONVERSION REQUIRED
@BOX 7.0
PL ACONV
SET CUR A TYPE
@BOX 8.0
PL ARITH FN(A=>LHS):11.11:
@BOX 9.0
RESET A AS NOT IN USE
@BOX 10.0
END
@B11
SET A TYPE FOR STRINGS:11.6:
PL MOVE
@BOX 12.0
PL LOAD STRING(LHS=):11.12:
@BOX 13.0
CODE.EXPR(RHS=)
:11.3:
@BOX 14.0
PL E.MOV
@BOX 15.0
END
@BOX 19.0
CONSTANT OF SAME TYPE AS LHS
@BOX 20.0
CHANGE CONSTANT TYPE :11.1:
@BOX 21.0
SET SIZE OF CONSTANT TO LHS
PL ARITH FN(A=):11.11:
@BOX 22.0
CAN AGGREGATE LOAD AND
STORE BE USED?
@BOX 23.0
SET A TYPE FOR
AGGREGATE MOVE
@BOX 24.0
PLANT A=RHS
NOTE A IN USE
PLANT A=>LHS
@BOX 1.1
;BEGIN
@BOX 2.1
;AS[RHAP] & %1F => T
;IF NT = 5
@BOX 3.1
;IF T = %10 OR T = %11
@BOX 4.1
;CODE.EXPR(RHAP,%22)=>T
@BOX 5.1
;LOAD.A.FROM.T()
@BOX 6.1
;IF AS[LHAP] => T & %F0E0 = AS[RHAP] & %F0E0
@BOX 7.1
;SET.A.TYPE(LHT!%10, T ->> 5 & %7)
@BOX 8.1
;PL.ARITH.FN(%20,LHAP)
@BOX 9.1
;-1=>A.AP.G
@BOX 10.1
;EXIT
;END
@BOX 11.1
;SET.A.TYPE(5, 0)
;TL.PL(%22,0)
@BOX 12.1
;PL.LOAD.STR(%20,LHAP)
@BOX 13.1
;CODE.EXPR(RHAP,%21)
@BOX 14.1
;TL.PL(%23,0)
@BOX 15.1
;EXIT
@BOX 19.1
;IF LHT=RHT
@BOX 20.1
;CONST OF PROPS.T[AS[RHAP+2]=>T] => CP
;IF AS[RHAP] & %1F=%11 THEN
   ;COPY.CONST(CP,0)=>CP=>CONST OF PROPS.T[T]
;FI
;AS[RHAP] & %8FFF ! (LHT <<- 12) => AS[RHAP]
;CHANGE.CONST.TYPE(CP,RHT,LHT)
@BOX 21.1
;AS[RHAP] & %FF1F ! (AS[LHAP] & %E0) => AS[RHAP]
;PL.ARITH.FN(REG,RHAP)
@BOX 22.1
;IF T & %10 /= 0
   AND [T < %14 OR T = %1B]
   AND STR.SIZE(RHAP)=>T >= 0
    AND STR.SIZE(LHAP) = T
@BOX 23.1
;T => CUR.A.DIM.G
;SET.A.TYPE(14, 0)
@BOX 24.1
;PL.LOAD.STR(%22,RHAP)
;RHAP => A.AP.G
;AS[RHAP] & %FFE0 ! %1C =>  AS[RHAP]
;PL.LOAD.STR(%20,LHAP)
@END
@TITLE FTN11.3.2(1,6)
@COL 1S-3R-5R-6F
@FLOW 1-3-5-6
@BOX 1.0
CONCATENATION NODE
@BOX 3.0
CODE EXPRFOR LHS:11.3:
@BOX 5.0
CODE EXPRFOR RHS:11.3:
@BOX 6.0
END
@BOX 1.1
;BEGIN
@BOX 3.1
;CODE.EXPR(LHAP,REG)
@BOX 5.1
;CODE.EXPR(RHAP,REG)
@BOX 6.1
;EXIT
;END
@END
@TITLE FTN11.3.3(1,11)
@COL 1S-2T-14T-15R-11T-3R-4R-5R-6R-7R-8F
@COL 9C-12R-13R
@ROW 3-9
@FLOW 1-2N-14N-15-11N-3-4-5-6-7-8
@FLOW 2Y-9
@FLOW 14Y-11
@FLOW 11Y-12-13-7
@BOX 1.0
COMPARE NODES
@BOX 2.0
ARITHMETIC COMPARE?
@BOX 3.0
SET A.MODE(STRINGS):11.6:
PL STR.COMP
@BOX 4.0
CODE.EXPR(LHS=):11.3:
@BOX 5.0
CODE.EXPR(RHS=):11.3:
@BOX 6.0
PL END COMP
@BOX 7.0
MAKE MODE INTO A
TERMINAL NODE WITH AN
OPERAND OF T
SAVE RELATIONAL INFO IN NODE
NOTE T.IN.USE
SET CODE.EXPR.RESULT
@BOX 8.0
END
@BOX 9.0
->OTHER NODES
:11.3.5:
@BOX 11.0
CAN AGGREGATE COMPARE BE USED?
@BOX 12.0
SET A MODE
@BOX 13.0
PLANT A = LHS
NOTE A IN USE
PLANT A COMP RHS
@BOX 14.0
A NOT IN USE?
@BOX 15.0
STACK A
SET A NOT IN USE
NOTE OPERAND ON STACK
@BOX 1.1
@BOX 2.1
;IF LHT /= 5
@BOX 3.1
;SET.A.TYPE(5,0) :: ??? JM 31-DEC-82
;TL.PL(%24,0)
@BOX 4.1
;CODE.EXPR(LHAP,%20)
@BOX 5.1
;CODE.EXPR(RHAP,%21)
@BOX 6.1
;TL.PL(%25,0)
@BOX 7.1
;AS[AP] & %70E0 ! %1E => AS[AP] & %E0 ->> 5 => CODE.EXPR
;AP => T.AP.G
@BOX 8.1
;EXIT
@BOX 9.1
;-> FTN11.3.5B1
@BOX 11.1
;IF AS[LHAP] & %1F => T & %10 /= 0 AND [T < %14 OR T = %1B] AND
    AS[RHAP] & %1F=>T & %10 /= 0 AND [T < %14 OR T = %1B] AND
    STR.SIZE(LHAP) => T > 0 = STR.SIZE(RHAP)
@BOX12.1
;T => CUR.A.DIM.G
;SET.A.TYPE(14,0) :: ??? JM 31-DEC-82
@BOX 13.1
;PL.LOAD.STR(%22, LHAP)
;LHAP => A.AP.G
;AS[LHAP] & %FFE0 ! %1C => AS[LHAP]
;PL.LOAD.STR(%2F, RHAP)
@BOX 14.1
;IF A.AP.G < 0
@BOX 15.1
;TL.PL(%47,%3000)
; 1+>AS[A.AP.G]
; -1 => A.AP.G
@END
@TITLE FTN11.3.4(1,10)
@COL 12R
@COL 1S-2T-3T-4T-5T-6R-7T-8R-9R-10R-11F
@COL 14R-16R
@ROW 12-4
@ROW 3-14
@ROW 6-16
@FLOW 1-2N-3N-4N-5N-6R-7N-8-9-10-11
@FLOW 3Y-12-5
@FLOW 4Y-12
@FLOW 2Y-14-5
@FLOW 5-16-6
@FLOW 7Y-9
@BOX 1.0
EXPONENTIATION NODE
@BOX 2.0
RHS A CONSTANT?
@BOX 3.0
RHS NOT A TERMINAL
NODE?
@BOX 4.0
RHS A FN REFN?
@BOX 5.0
LHS A CONSTANT:11.3:
@BOX 6.0
CODEEXPR FOR LHS:11.3:
@BOX 7.0
INCREASE IN PRECISION NOT
REQUIRED?
@BOX 8.0
PL A CONV
@BOX 9.0
PL ARITH.FN(**RHS):11.11:
@BOX 10.0
MAKE MODE INTO A
TERMINAL NODE
NOTE A/B IN USE
@BOX 11.0
END
@BOX 12.0
CODE.EXPR:11.3:
@BOX 14.0
CHECK.CONSTANT : 11.14:
CONVERT RHS CONST TO LHS TYPE
UNLESS RHS >= PRECISION THAN LHS
OR RHS INTEGER
@BOX 16.0
CHECK.CONSTANT : 11.14:
CONVERT LHS CONST TO RHS TYPE
UNLESS LHS >= PRECISION THAN RHS
@BOX 1.1
;BEGIN

@BOX 2.1
;IF AS[RHAP] & %1F => T = %10 OR T = %11
@BOX 3.1
;IF T < %10
@BOX 4.1
;IF T > %13 < %18
@BOX 5.1
;IF AS[LHAP] & %1F => T = %10 OR T = %11
@BOX 6.1
;CODE.EXPR(LHAP,REG)
@BOX 7.1
;IF RANK[LHT * 5 + RHT] => T = 2 THEN
   ;AS[RHAP] & %E0 - (AS[LHAP] & %E0) => T
;FI
;IF T =< 0
@BOX 8.1
;SET.A.TYPE(%10!RHT, AS[RHAP] ->>5 & %7)
@BOX 9.1
;PL.ARITH.FN(REG & %20 ! %1F, RHAP)
@BOX 10.1
;AS[AP] & %F1E0 ! %1C => AS[AP]
;IF REG & %20 /=0 THEN
   ;AP => A.AP.G
;ELSE
   ;AP => B.AP.G
;FI
@BOX 11.1
;EXIT
;END
@BOX 12.1
;CODE.EXPR(RHAP,REG)
@BOX 14.1
;IF RHT /= 3 THEN
   ;CHECK.CONST(RHAP,RHT,LHT)
;FI
@BOX 16.1
;CHECK.CONST(LHAP,LHT,RHT)
@END
@TITLE FTN11.3.5(1,10)
@COL 1S-2T-3T-4R-22R-5T-6T-7R-23R-8R-9F
@COL 18R-20R
@ROW 3-18
@ROW 6-20
@FLOW 1-2N-3N-4-22-5N-6N-7-23-8-9
@FLOW 2Y-18-5
@FLOW 3Y-5Y-20-8
@FLOW 6Y-8
@BOX 1.0
OTHER NODES
@BOX 2.0
LHS A CONST?
@BOX 3.0
LHS A TERMINAL MODE
@BOX 4.0
CODE.EXPR FOR LHS:11.3:
@BOX 5.0
RHS A CONSTANT?
@BOX 6.0
RH A TERMINAL NODE?
@BOX 7.0
CODE EXPR FOR RHS:11.3:
@BOX 8.0
CODE OPERATOR :11.3.6:
@BOX 9.0
END
@BOX 18.0
CHECK.CONSTANT : 11.14:
CONVERT LHS CONST TO RHS TYPE
UNLESS LHS >= PRECISION RHS
@BOX 20.0
CHECK CONSTANT : 11.14:
CONVERT RHS CONST TO LHS TYPE
UNLESS RHS >= PRECISION LHS
@BOX 22.0
IF IN T REG LOAD A
:11.15:
@BOX 23.0
IF IN T REG LOAD A
:11.15:
@BOX 1.1
;FTN11.3.5.B1:
;BEGIN
@BOX 2.1
;IF AS[LHAP] & %1F => T = %10 OR T = %11
@BOX 3.1
;IF T > %F
@BOX 4.1
;CODE.EXPR(LHAP,REG)
@BOX 5.1
;IF AS[RHAP] & %1F => T = %10 OR T = %11
@BOX 6.1
;IF T > %F
@BOX 7.1
;CODE.EXPR(RHAP,REG)
@BOX 8.1
;CODE.OP(AP,LHAP,RHAP,LHT,RHT)=>CODE.EXPR
@BOX 9.1
;END
@BOX 18.1
;CHECK.CONST(LHAP,LHT,RHT) => LHT
@BOX 20.1
;CHECK.CONST(RHAP,RHT,LHT) => RHT
@B22.1
;LOAD.A.FROM.T()
@BOX 23.1
;LOAD.A.FROM.T()
@END
@TITLE FTN11.3.6(1,11)
@COL 1S-8T-9T-10R-11R-12T-13R-14R-15R-16F
@COL 21R
@ROW 10-21
@FLOW 1-8N-9N-10-11-12N-13-14-15-16
@FLOW 8Y-12
@FLOW 9Y-21-11
@FLOW 12Y-14
@BOX 1.0
CODE OPERATOR(AP,LAP,RHAP,LHT,RHT)
@BOX 8.0
EITHER NODE LOADED
@BOX 9.0
OPS OF DIFFERENT TYPE?
@BOX 10.0
SELECT OP WHICH IS A FN REFN
TO LOAD FIRST.
OTHERWISE SELECT LHS TO LOAD FIRST
@BOX 11.0
PL ARITH.FN(LOAD):11.11:
@BOX 12.0
INCREASE IN PRECISION NOT REQUIRED?
@BOX 13.0
PL A CONV
@BOX 14.0
REVERSE OP IF NECESSARY
PL ARITH.FN(OP OTHER OPERAND):11.11:
@BOX 15.0
MAKE NODE INTO A TERMINAL
NODE.
@BOX 16.0
END
@BOX 21.0
CHOOSE THE SMALLEST
PRECISION TO LOAD FIRST
@BOX 1.1
;PROC CODE.OP(AP,LHAP,RHAP,LHT,RHT)
;$IN LHK,RHK,T,LHZ,RHZ,AZ,OP.Z
;$IN OPR
;$IN OP.AP
;$IN FL,INV,AT,OPT
@BOX 8.1
;0 => FL
;AS[LHAP] => LHZ & %1F => LHK
;AS[RHAP] => RHZ & %1F => RHK
;IF LHZ & %800 = 0
    THEN LHZ ->> 5 & 7 => LHZ
    ELSE 0 => LHZ ; %800 -=> AS [LHAP]
 FI :: ??? JM 28-FEB-83
;IF RHZ & %800 = 0
    THEN RHZ ->> 5 & 7 => RHZ
    ELSE 0 => RHZ ; %800 -=> AS [RHAP]
 FI :: ??? JM 28-FEB-83
;IF LHK = %1C THEN
   ;1 => FL
;ELSE IF RHK = %1C THEN
   ;2 => FL
;FI FI
;IF FL > 0
@BOX 9.1
;IF LHT /= RHT
@BOX 10.1
;IF RHK > 3 < 7 THEN
   ;2=>FL
;ELSE
   ;1 => FL
;FI
@BOX 21.1
;IF 2 - RANK[LHT*5 + RHT] => FL = 0 THEN
   ;IF LHZ > RHZ THEN
      ;2 => FL
   ;ELSE
      ;1 => FL
   ;FI
;FI
@BOX 11.1
;IF FL = 1 THEN
   ;LHAP => T
;ELSE
   ;RHAP => T
;FI
;PLARITHFN(REG,T)
@BOX 12.1
;IF FL=1 THEN
   ;LHT => A.T ;RHT => OP.T
   ;LHZ => AZ  ;RHZ => OPZ
;ELSE
   ;RHT => A.T; LHT => OP.T
   ;RHZ => AZ ; LHZ => OP.Z
;FI
;IF RANK[AT*5 + OP.T] => T = 2 THEN
   OP.Z - A.Z => T
;FI
;IF T =< 0 OR REG = 2
@BOX 13.1
;SET.A.TYPE(OP.T!%10, OP.Z)
@BOX 14.1
;0=>INV
;AS[AP] => T & %F => OPR ;RHAP => OP.AP
;IF FL=2 THEN
   ;REV.FN[OPR] => OPR
   ;LHAP => OP.AP
   ;IF OPR = 15 THEN
      ;1=>INV
   ;FI
;FI
;IF OPR=15 AND [AS[OP.AP] & %F >=4 =< 7] THEN
   ;1-=>INV
;FI
;IF INV = 1 THEN
   ;REV.REL[T->>5 -1 &7] ! (T & %FF1F) =>AS[AP]
;FI
;PL.ARITH.FN(REG & %20 + OPR, OP.AP)
@BOX 15.1
;IF OPR = 15 THEN
   ;%81E => T
   ;AP => T.AP.G
   ;AS[AP] ->> 5 & %7 => CODE.OP
   ;-1=>A.AP.G
;ELSE
   ;%1C => T
   ;IF REG & %20 /=0 THEN
      ;AP => A.AP.G
   ;ELSE
      ;AP => B.AP.G
   ;FI
   ;-1 => CODE.OP
;FI
;AS[AP]  & %FFE0 ! T => AS[AP]
@BOX 16.1
;END
@END
@TITLE FTN11.4(1,11)
@COL 16R-17T-18R-19C-20T-21R
@COL 1S-2T-3T-4T-5R-22R-6R-7R-8R-9T-10R-11T-12T-13R-14R-15F
@ROW 16-6
@ROW 17-12
@ROW 20-13
@FLOW 1-2N-3N-4N-5-22-6-7-8-9N-10-8
@FLOW 2Y-16-19
@FLOW 3Y-6
@FLOW 4Y-22
@FLOW 9Y-11Y-17N-18-19
@FLOW 11N-12N-13-14-15
@FLOW 17Y-15
@FLOW 12Y-20N-21-14
@FLOW 20Y-15
@BOX 1.0
CODE.SUBSCRIPTS(NAME,SUBS,EXPR.TYPE)CONSTANT
@BOX 2.0
WRONG N0 SUBSCRIPTS?
@BOX 3.0
CONSTANT EXPR REQUIRED?
@BOX 4.0
B NOT IN USE?
@BOX 5.0
PL STACK B
UPDATE NODE PREVIOUSLY
ASSOCIATED WITH B
@BOX 6.0
NOTE B UNLOADED
SET CONST.PART=0
@BOX 7.0
GET LAST SUBSCRIPT
@BOX 8.0
CODE SUBSCRIPT:11.4.1:
@BOX 9.0
NO MORE SUBSCRIPTS?
@BOX 10.0
GET PREVIOUS SUBSCRIPT
@BOX 11.0
CONSTANT EXPR EXPECTED?
@BOX 12.0
B LOADED?
@BOX 13.0
SET B.FN TO =
@BOX 14.0
PL B.FN CONST.PART
@BOX 15.0
END-CONST
.PART
@BOX 16.0
FAULT
@BOX 17.0
B NOT LOADED?
@BOX 18.0
FAULT
@BOX 19.0
END-1
@BOX 20.0
CONST PART
= ZERO
@BOX 21.0
SET B.FN TO
+
@BOX 22.0
SET B TYPE
@BOX 1.1
;PROC CODE.SUBSCRIPTS(NA,SAP,ET)
;ADDR LOCAL.PROP L.P
;ADDR[$IN] ARR
;$IN N,  BFL, CP, BOP,CNT
;PSPEC REMOVE.CONSTANTS($IN)/$IN
#FTN11.4.2


@BOX 2.1
;LOC OF PROPS.T[NA] => F.L.PROP.G =>   L.P
;L.ARR.SPEC.P OF L.P^ => ARR
;IF AS[ SAP] => N => CNT /= ARR^[0]
@BOX 3.1
;IF E.T = 1
@BOX 4.1
;IF B.AP.G < 0
@BOX 5.1
;TL.PL(%47,%2000)
;1+>AS[B.AP.G]
;-1 => B.AP.G
@BOX 6.1
;0 => BFL => CP
@BOX 7.1
;N +> SAP
@BOX 8.1
#FTN11.4.1
@BOX 9.1
;IF 1->CNT =< 0
@BOX 10.1
;1->SAP
@BOX 11.1
;IF ET=1
@BOX 12.1
;IF BFL /= 0
@BOX 13.1
;2 => B.OP
@BOX 14.1
;TL.C.LIT.32(I.ACC.T.L,CP)
;TL.PL(B.OP,0)
@BOX 15.1
;CP => CODE.SUBSCRIPTS
;END
@BOX 16.1
;FAULT(94,1)
@BOX 17.1
;IF BFL =0
@BOX 18.1
;FAULT(95,1)
@BOX 19.1
;-1 => CODE.SUBSCRIPTS
;EXIT
@BOX 20.1
;IF CP = 0
@BOX 21.1
;9 => BOP
;0 -:> CP
@BOX 22.1
;SET.B.TYPE(ARR^[1]->>30)
@END
@TITLE FTN11.4.1(1,11)
@COL 1S-2R-3T-4R-29R-5T-6R-7R-8T-9R-10T-11T-12R-13T-14R-15F
@COL 18R-19R-20T-21R-22R-23T-24T-25R-26R-27R
@COL 28R
@ROW 4-18
@ROW 9-20
@ROW 25-28
@FLOW 1-2-3N-4-29-5N-6-7-8N-9-10N-11N-12-13N-14-15
@FLOW 3Y-18-8
@FLOW 5Y-19-7
@FLOW 8Y-20N-21-22-10
@FLOW 20Y-22
@FLOW 10Y-15
@FLOW 11Y-23N-24N-25-26-27-15
@FLOW 23Y-27
@FLOW 24Y-28-26
@FLOW 13Y-15
@BOX 1.0
CODE SUBSCRIPT
@BOX 2.0
OBTAIN DIMENSION INF0
@BOX 3.0
SUBSCRIPT A CONSTANT?
@BOX 4.0
REMOVE CONSTANTS:11.4.2:
ADD THEM TO CONST.PART
@BOX 5.0
B NOT LOADED?
@BOX 6.0
ADD A NEW NODE
TO EXPR TREE
B+
@BOX 7.0
CODE.EXPR(IN B):11.3:
@BOX 8.0
LOWER DIMENSION BOUND
ADJUSTABLE
@BOX 9.0
SUBTRACT LOWER BOUND
FROM CONST PART
@BOX 10.0
STRIDE OF 1?
@BOX 11.0
ADJ DIMENSION?
@BOX 12.0
MULTIPLY CONSTANT
SUBSCRIPT PART BY STRIDE
@BOX 13.0
B NOT LOADED?
@BOX 14.0
PL B * STRIDE
@BOX 15.0
END
@BOX 18.0
ADD IT TO CONST PART
@BOX 19.0
NOTE B LOADED
@BOX 20.0
B LOADED?
@BOX 21.0
PL B = CONST.PART
NOTE B.LOADED
SET CONST.PART = 0
@BOX 22.0
PL B - LOWER BOUND
@BOX 23.0
CONST PART ZERO?
@BOX 24.0
B NOT LOADED?
@BOX 25.0
SET B.FN TO +
@BOX 26.0
PL B FN CONST.PART
SET CONST.PART = 0
@BOX 27.0
PL B * ADJ:STRIDE
@BOX 28.0
SET B.FN TO =
NOTE B.LOADED
@BOX 29.0
INCREASE PRECISION OF
B IF NECESSARY
@BOX 1.1
;BEGIN
;$IN NAP,N0,K,DK,CNT2,LB,UB,STR,B.OP,EAP,APF,SH,T
;ADDR CONST.PROP CPTR
@BOX 2.1
;CNT*2-2=>SH
;ARR^[1] ->> SH => DK
;ARR^[CNT*3-1] => LB; ARR^[CNT*3] => UB
;ARR^[CNT*3-2] => STR
;AS[SAP] => NAP
@BOX 3.1
;IF AS[NAP] => N0 & %1F => K = %10 OR K = %11
@BOX 4.1
;REMOVE.CONSTANTS(NAP)=>NAP
@BOX 5.1
;IF BFL = 0
@BOX 6.1
;END.AP.G => APF => B.AP.G
;CUR.B.TYPE.G<<-5!%301C => AS[APF]
;%3008 => AS[APF+1]
;APF => AS[APF+2] +1  => EAP
;NAP => AS[APF+3]
; 4 +> END.AP.G
@BOX 7.1
;CODE.EXPR(EAP,%2)
@BOX 18.1
;CONST OF PROPS.T[AS[NAP+2]] => CPTR
;INT.CONST OF CPTR^+> CP
@BOX 19.1
;1 => BFL
;NAP => EAP
@BOX 8.1
;IF DK & 4 /= 0
@BOX 9.1
;LB -> CP
@BOX 10.1
;IF CNT=1
@BOX 11.1
;IF DK & 3 /=0
@BOX 12.1
;STR *> C.P
@BOX 13.1
;IF B.FL = 0
@BOX 14.1
;TL.C.LIT.32(I.ACC.T.L,STR)
;TLPL(%B,0)
@BOX 15.1
;END
@BOX 20.1
;IF B.FL /= 0
@BOX 21.1
;TL.C.LIT.32(I.ACC.T.L,CP)
;TL.PL(2,0 => CP)
@BOX 22.1
;TL.C.LIT.32(I.ACC.T.L,LB)
;TL.PL(9,0)
@BOX 23.1
;IF CP =0
@BOX 24.1
;IF B.FL =0
@BOX 25.1
;8 => B.OP
@BOX 26.1
;TL.C.LIT.32(I.ACC.T.L,CP)
;TL.PL(B.OP,0=>C.P)
@BOX 27.1
;IF BFL /= 0 THEN
    TL.PL(%B,STR) FI
@BOX 28.1
;2 => B.OP
;1 => BFL
@BOX 29.1
;IF AS[NAP]->>5&7=>T>CUR.B.TYPE.G THEN
    SET.B.TYPE(%10!T)
 FI
@END
@TITLE FTN11.4.2(1,10)
@COL 11R-12R
@COL 1S-2T-3T-4T-5T-6T-7T-8R-9R-10F
@COL 13N-14R-15R-16N
@ROW 3-13
@ROW 5-14
@ROW 7-15
@ROW 8-16
@ROW 11-6
@FLOW 1-2N-3N-4N-5N-6N-7N-8-9-10
@FLOW 2Y-13-16-10
@FLOW 3Y-13
@FLOW 4Y-14-6
@FLOW 5Y-11-12-2
@FLOW 6Y-15-16
@FLOW 7Y-16
@BOX 1.0
REMOVE.CONSTANTS(ROOT.NODE.AP)ROOT.NODE.AP
@BOX 2.0
ROOT A TERMINAL NODE?
@BOX 3.0
NOT A + OR - MODE
@BOX 4.0
LH NODE NOT TERMINAL?
@BOX 5.0
+ NODE AND L.H.S
OPERAND A CONSTANT?
@BOX 6.0
RH NODE NOT TERMINAL?
@BOX 7.0
RH OP NOT A CONSTANT?
@BOX 8.0
ADD OR SUBTRACT CONSTANT
OF R.H NODE TO CONST.PART
@BOX 9.0
MAKE LH NODE INTO ROOT NODE
@BOX 10.0
END
@BOX 11.0
ADD LH CONST
TO CONST PART
@BOX 12.0
MAKE RH NODE INTO
ROOT NODE
@BOX 14.0
REMOVE CONSTANTS
FROM LH NODE EXPR:11.4.2:
@BOX 15.0
REMOVE CONSTANTS
FROM RH NODE EXPR:11.4.2
@BOX 1.1
;PROC REMOVE.CONSTANTS(AP)
;$IN LH,V,NO,OP,LHAP,LHK,RHAP,RHK
;ADDR CONST.PROP CPTR

@BOX 2.1
;IF AS[AP] => NO & %1F => OP > %F
@BOX 3.1
;IF OP /=8 /=9
@BOX 4.1
;IF AS[AS[AP+1] => LHAP] & %1F => LHK < %10
@BOX 5.1
;IF OP=8 AND [LHK = %10 OR LHK =  %11]
@BOX 6.1
;IF AS[AS[AP+2] => RHAP] & %1F => RHK < %10
@BOX 7.1
;IF RHK /= %10 /= %11
@BOX 8.1
;CONST OF PROPS.T[AS[RHAP+2]] => CPTR
;INT.CONST OF C.PTR^ => V
;IF OP = 8 THEN
   ;V +> CP
;ELSE
   ;V -> CP
;FI
@BOX 9.1
;LHAP => AP
@BOX 10.1
;AP => REMOVE.CONSTANTS
;END
@BOX 11.1
;CONST OF PROPS.T[AS[LHAP+2]] => CPTR
;INT.CONST OF C.PTR^ +> CP
@BOX 12.1
;AS[AP+2] => AP
@BOX 14.1
;REMOVE.CONSTANTS(LHAP) => AS[AP+1]
@BOX 15.1
;REMOVE.CONSTANTS(RHAP) => AS[AP+2]
@END
@TITLE FTN11.5(1,11)
@COL 1S-20R-2R-4T-5R-6R-7T-8R
@COL 21R-14T-23T-24R-15R-25T-26R-22R-19R-16F
@FLOW 1-20-2-4N-5-6-7N-8-7
@FLOW 4Y-21-6
@FLOW 7Y-14N-23N-24-15-25N-26-16
@FLOW 25Y-19-16
@FLOW 23Y-15
@FLOW 14-22-19
@BOX 1.0
CODE.PROC.CALL(AP)
@BOX 20.0
CODE INLINE INTR SUBROUTINE
@BOX 2.0
OBTAIN SPEC OF FUNCTION
OBTAIN FIRST ARG ENTRY FOR STAT FN
OBTAIN INTR PROPS OF INTR FN
@BOX 4.0
INTRINSIC?
@BOX 21.0
PLANT INIT CODE IF ANY
@BOX 22.0
PLANT EXIT CODE IF ANY
@BOX 5.0
PL STACKLINK
@BOX 6.0
OBTAIN FIRST ARGUMENT
@BOX 7.0
NO MORE ACTUAL OR DUMMY ARGUMENTS?
@BOX 8.0
CODE ARGUMENT:11.5.0:
@BOX 14.0
INTRINSIC?
@BOX 23.0
NOT A CHAR FUNCTION
OR A STAT FN?
@BOX 24.0
STACK REFN PARAM TO RESULT
STACK LENGTH OF RESULT
@BOX 15.0
PLANT CALL
@BOX 25.0
NOT A CHAR FUNCTION
OR A STAT FN?
@BOX 26.0
SET A TYPE TO CHAR
PLANT D = REF OF RESULT
VARIABLE
@BOX 19.0
SET CUR A TYPE
@BOX 16.0
END
@BOX 1.1
;PROC CODE.PROC.CALL(AP)
;LITERAL/ADDR [$LO8] NIL.STR=
;ADDR [$LO8] ARG,CP
;ADDR A
;$IN STR.FN, FARG.K, AZ, EZ, TL.N, CH, ET, D.PR
;$IN PK,RN,INTR,T,N0,P,N,EK,FA,FAK,VAR.F,AT,AN,SW,T1
;ADDR LOCAL.PROP  LP,ARG.LP,ST.FN.ARG.LP
;ADDR GLOBAL.PROP  GP
;$IN NAM,INTR.FN,INTR.IN,ARG.E.AP,ARG.0,D.OP,L,ARG.AP
;$IN PROC.MUTL.NAME, RTN.TYPE
;0 => VAR.F => INTR.FN => INTR
;LOC OF PROPS.T[AS[AP+2]] => LP
@BOX 2.1
;IF AS[AP] => N0 & %F => PK = 7 THEN
   ;AS[AP+1]=> D.PR & %FFF => INTR * 7 =>T
   ;INTR.INFO[INTR]=>INTR.IN
   ;PART(^INTR.ARG.SPECS,T,T+7)=>ARG
   ;D.PR ->> 12 => D.PR
;ELSE L.ARG.SPEC.P OF L.ALT OF LP^ => ARG FI
;IF PK = 4 THEN L.LINK2 OF LP^ => ST.FN.ARG.LP FI
@BOX 4.1
;IF PK=7
@BOX 21.1
;IF INTR >= 12 < 16 THEN
  ;%2A=>INTR.FN
;ELSE IF INTR = %41 THEN
  ;%26=>INTR.FN
;ELSE IF INTR = 6 THEN
  ;%28=>INTR.FN
;FI FI FI
;IF INTR.FN > 0 THEN
  ;SET.A.TYPE(5, 0)
  ;TL.PL(INTR.FN,0)
;FI
@BOX 22.1
;IF INTR.FN /= 0 THEN
  ;TL.PL(INTR.FN+1,0)
  ;IF INTR.FN=%2A THEN
    ::LEXICAL INTRINSIC
    ;SET.A.TYPE(4,0)
    ;TL.PL(%22,%FFE+INTR)
  ;ELSE
    ::INDEX LEN
    ;SET.A.TYPE(3,1)
    ;TL.PL(%22,%2000)
  ;FI
;FI
@BOX 5.1
;IF N0 & %200 /=0 OR L.SPECS OF LP^ & %800 /= 0 THEN
   ;L.SPEC.TL.NAME OF L.ALT OF LP^ => PROC.MUTL.NAME
;ELSE L.TL.NAME OF LP^ => PROC.MUTL.NAME FI
;TLPL(%40,PROC.MUTL.NAME)
@BOX 6.1
;2 => P
;0 => TL.N
;AS[AS[AP+4] => ARG.AP] => N => AN
@BOX 7.1
;ARG^[P] => FA
;IF  N=0
@BOX 8.1
#FTN11.5.0
@BOX 3.1
;IF N=0 AND [ARG^[P] = %FF
      OR VAR.F/=0]
@BOX 13.1
;LP => F.L.PROP.G
;FAULT(97,1)
@BOX 14.1
;IF PK=7
@BOX 23.1
;IF L.TYPE OF LP^ /= 5
      OR PK = 4 OR PK = 5
@BOX 24.1
;SET.A.TYPE(6,0)
;TL.PL(%21,L.CH.RES.NAME
      OF L.ALT OF LP^=>RN)
;TL.PL(%41,%3000)
;SET.A.TYPE(3, 1)
;TL.C.LIT.16(%44, L.LEN OF LP^)
;TL.PL(%22,0)
;TL.PL(%41,%3000)
@BOX 15.1
;IF N0 & %200 /= 0 THEN
   ;L.TL.NAME OF LP^ => T
;ELSE
   ;0 => T
;FI
;TL.PL(%42,T)
@BOX 25.1
;IF L.TYPE OF LP^ /= 5
      OR PK = 4  OR PK = 5
@BOX 26.1
;SET.A.TYPE(5,0)
;TL.PL(%61,RN)
@BOX 16.1
;END
@BOX 19.1
;IF ARG^[1] => T = %20 THEN
   ;N0 ->> 5 & 7 => T
;FI
;IF ARG^[0] & 7 => RTN.TYPE = 7
    THEN SET.A.TYPE (3,1)
    ELSE SET.A.TYPE (RTN.TYPE, T)
 FI
@BOX 20.1
;PSPEC CODE.INL.INTR($IN)
#FTN11.5.4
@END
@TITLE FTN11.5.0(1,10)
@COL 1S-8R-10R-11R-12R-13F
@FLOW 1-8-10-11-12-13
@BOX 1.0
CODE ARGUMENT
@BOX 8.0
SET FORMAL ARG TYPE AND SIZE
AND ACTUAL ARG TYPE AND SIZE
@BOX 10.0
UPDATE PERMITTED ARGUMENT TYPE
SET STR FN FOR CHARACTER INTRINSIC
@BOX 11.0
SET TL NAME FROM ANAL RECORD
PROCESS ACCORDING TO ACTUAL ARG
KIND AND FORMAT ARG SPECIFICATION
-
ARITH ARGS PASSED BY VALUE:11.5.1:
ARGS PASSED BY REFN:11.5.2:
CHAR ARGS PASSED BY REFN:11.5.3:
CHAR ACTUALS PASSED AS LOGICAL 64[FTN11.5.5]
@BOX 12.0
RESET REG USE INFO
GET NEXT ARGUMENT
@BOX 13.0
END
@BOX 8.1
;AS[AS[1 +> ARG.AP] => ARG.E.AP] => ARG.0 ->> 12 & 7 => ET;
;IF ARG0 & %1F = %F THEN
   ;0 => EZ
;ELSE
   ;ARG.0 ->> 5 & %7 => EZ
;FI
;IF ARG^[P + 1] => AZ = %20 THEN D.PR => AZ FI
;FA & 7 => AT
@BOX 10.1
;IF INTR.FN /= 0 THEN
   ;%22 - N => STR.FN
;ELSE IF INTR /= 54 THEN
   ;%21 => STR.FN
;ELSE
   ;0 => STR.FN
;FI FI
@BOX 11.1
;AS[ARG.E.AP+1]=>NAM
;IF  [PK = 4 OR PK = 7] AND AT /= 5, ->F1B9
;IF FA & 8 =0 THEN 0 => SW ELSE 26 => SW FI
;IF ET = 5 THEN 13+>SW FI
;IF ARG.0 & %10 /=0 THEN ARG.0 & %F+1+>SW FI
::COLS OF SWITCH ARE
::  EXPR,CONST,CONST.NAME,VAR,
::   ARREL,ST.FN,SUBR.REFN,
::  FN.REFN,INTR,ARR,FN.NAME,
::   LABEL,SUBSTRINGS
::ROWS ARE ARITH VALUE ARGS NON INTR
::         CHAR VALUE ARGS NON INTR
::         ARITH REF ARGS NON INTR
::         CHAR REF ARGS NON INTR
;SWITCH SW\
F1B5,F1B5,F1B5,F1B5,F1B5,F1B5,F1B5,F1B5,
     F1B5,F,F2B16,F2B14,F,
F5B2,F5B10,F5B10,F5B10,F5B10,F5B10,F,F5B10,
     F,F,F2B16,F,F5B10,
F2B2,F2B22,F2B2,F2B12,F2B8,F2B2,F2B2,F2B2,
     F2B2,F2B12,F2B16,F2B14,F,
F3B2,F3B13,F3B13,F3B13,F3B13,F3B13,F3B13,F3B13,
     F3B2,F3B13,F2B16,F2B14,F3B11
#FTN11.5.1
#FTN11.5.2
#FTN11.5.3
#FTN11.5.5
;F:
;FAULT(98, 1)
;NEXT.ARG:
@BOX 12.1
;IF AT /= 6 THEN
    1 +> TL.N
   ;IF AT = 5 THEN
       1 +> TL.N
    FI
 FI
;-1 => A.AP.G => B.AP.G => T.AP.G   ;1 -> N
;IF ARG^[2+P] /= %FE THEN 2+>P ELSE 1=>VAR.F FI
@END
@TITLE FTN11.5.1(1,11)
@COL 1S-9R-10R-21T-11R-12C-22R-23C-5R-6R-7R-8C
@FLOW 5-6-7-8
@FLOW 9-10-21N-11-12
@FLOW 21Y-22-23
@BOX 1.0
CODE.PROC.CALL/CONST
ARITH ARGS BY VALUE
@BOX 5.0
EXPRS, FN REFS
FOR NON-INTRINSIC PROCS
@BOX 6.0
CODE.EXPR(IN A):11.3:
LOAD A FROM T IF NECESSARY
PLANT CONV IF NECESSARY
@BOX 7.0
PL STACK.PAR(A)
@BOX 8.0
END
@BOX 9.0
ARITH ARGS FOR STAT FNS
AND STANDARD INTR FNS
@BOX 10.0
CODE.EXPR(IN A):11.3:
PLANT CONV IF NECESSARY
@BOX 11.0
PL INTRINSIC FN INSTRUCTION
@BOX 12.0
END
@BOX 21.0
STATEMENT FN?
@BOX 22.0
PL A => STATIC ARGUMENT
GET NEXT ARG PROP PTR
@BOX 23.0
END
@BOX 1.1
@BOX 5.1
;F1B5:
@BOX 6.1
;CODE.EXPR(ARG.E.AP,%22)
;LOAD.A.FROM.T ()
;IF ET /= AT OR AZ /= EZ THEN
   ;SET.A.TYPE(%10 ! AT, AZ)
;FI
@BOX 7.1
;TL.PL(%41,%3000)
@BOX 8.1
;->NEXT.ARG
@BOX 9.1
;F1B9:
@BOX 10.1
;CODE.EXPR(ARG.E.AP,%22)
;IF ET /= AT OR AZ /= EZ THEN
   ;SET.A.TYPE(%10 ! AT, AZ)
;FI
@BOX 11.1
;IF N= AN THEN
   ;0 => T
;ELSE IF N=1 THEN
   ;2=>T
;ELSE
   ;1=>T
;FI FI
;IF INTR.IN & %40 = 0 THEN
;TL.PL(%32,INTR.TL.FN[INTR.IN & %3F *3+T]=>T & %7F)
;IF T & %80 /= 0 THEN
  ;N0 ->> 5 & 7 => T1
  ;IF ARG^[0] & 7 => T /= ARG^[2] & 7
      OR  T1 /= AZ THEN
    ;SET.A.TYPE(T!%10,T1)
;FI FI
;ELSE
  ;IF T/= 0 THEN 1=>T FI
  ;CODE.INL.INTR(INTR.IN & %3F + T)
;FI
@BOX 12.1
;->NEXT.ARG
@BOX 21.1
;IF PK = 4
@BOX 22.1
;TL.PL(%20,L.TL.NAME OF ST.FN.ARG.LP^)
;L.LINK2 OF ST.FN.ARG.LP^=>ST.FN.ARG.LP
@BOX 23.1
;->NEXT.ARG
@END
@TITLE FTN11.5.2(1,11)
@COL 26R-27R-28T-29R-30R-31R-32R
@COL 1S-2R-3R-34T-4R-5R-33R-6R-7C-8R-9R-10R-11R
@COL 22C-35T-24R-25R-12R-18R-13T-14R-23C-21R-15R-16C-17R
@ROW 2-22
@ROW 26-4
@FLOW 2-3-34N-4-5-33-6-7
@FLOW 8-9-10-11-6
@FLOW 12-18-13N-21-5
@FLOW 13Y-15-5
@FLOW 14-23
@FLOW 16-17-13
@FLOW 34Y-26-27-28N-29-30-31-32-33
@FLOW 28Y-30
@FLOW 22-35N-24-25-13
@FLOW 35Y-3
@BOX 1.0
CODE FN CALL/CONT
ARITH ARGUMENT PASSED BY REFN
@BOX 2.0
ARITH ARGUMENTS
CONST,CONST.NAME,
EXPR,FN.REFN
@BOX 3.0
CODE.EXPR(IN A):11.3:
LOAD A FROM T IF NECESSARY
@BOX 4.0
PLANT CONVERT IF NECESSARY
DECLARE DUMP VARIABLE FOR IT
PL A => DUMP
SET A TYPE
@BOX 5.0
PLANT A LOAD
@BOX 6.0
PL STACK A
@BOX 7.0
END
@BOX 8.0
ARITH
ARRAY EL ARGUMENT
@BOX 10.0
SET.A.TYPE
PLANT A = OR
A = REF(IF DUMMY)
@BOX 9.0
CODE.SUBSCRIPTS:11.4:
@BOX 11.0
PL BASE
CONVERT AMODE TO BOUNDED
IF NECESSARY
@BOX 12.0
ARITH
VARIABLE, ARRAY
@BOX 13.0
VARIABLE A DUMMY?
@BOX 14.0
"LABEL ARGUMENT"
@BOX 16.0
FN NAMES
@BOX 17.0
SET A TYPE
@BOX 18.0
NOTE IF ARRAY
SET A TYPE
@BOX 21.0
SET LOAD ORDER
TO A = REF
@BOX 15.0
SET LOAD ORDER
TO A =
@BOX 23.0
END
@BOX 22.0
CONST
@BOX 24.0
DECLARE VECTOR OF BYTE VALUES AND
COPY HOLL VALUE TO IT
@BOX 25.0
SET A TYPE TO CHAR REF
@BOX 26.0
START A BLOCK
@BOX 27.0
GET DUMP VARIABLES
@BOX 28.0
ACC SIZE NOT 32 BIT
@BOX 29.0
PLANT ACONV 32 BIT
@BOX 30.0
PLANT A => DUMP
@BOX 31.0
SET A TYPE
@BOX 32.0
PLANT A LOAD REF DUMP
END BLOCK
@BOX 33.0
IF AMODE UNBOUNDED AND
ARGUMENT MODE BOUNDED THEN CONVERT
AMODE TO BOUNDED
PL A LOAD
@BOX 34.0
FORMAL ARG STILL VALUE SIZED
@BOX 35.0
NOT A HOLL CONSTANT?
@BOX 1.1
@BOX 2.1
;F2B2:
@BOX 3.1
;CODE.EXPR(ARG.E.AP,%22)
;LOAD.A.FROM.T ()
@BOX 4.1
;IF E.Z /= A.Z THEN
    ;SET.A.TYPE(AT ! %10, AZ)
;FI
;TL.PL(%20, V.DECL(AT, AZ, 0) => NAM)
; %21 => D.OP
;SET.A.TYPE(8 ! AT, AZ)
@BOX 5.1
;TL.PL(D.OP, NAM)
@BOX 33.1
;IF AT >= 0 AND CUR.A.TYPE.G & 3 = 1 AND
    D.ARG.TYPE.L = 3 THEN
      ;TL.PL(%45, CUR.A.TYPE.G ! 2
                   => CUR.A.TYPE.G)
;FI
@BOX 6.1
;TL.PL(%41,%3000)
@BOX 7.1
;->NEXT.ARG
@BOX 8.1
;F2B8:
@BOX 9.1
;CODE.SUBSCRIPTS(AS[ARG.E.AP+2],AS[ARG.EAP+4],0)
@BOX 10.1
;IF ARG.0 & %200 /= 0 THEN
   ;%22 => D.OP
;ELSE
   ;%21 => D.OP
;FI
;SET.A.TYPE(%48!AT, AZ)
;TL.PL(D.OP,NAM)
@BOX 11.1
;TL.PL(%26,BASE.OP.L)
@BOX 12.1
;F2B12:
@BOX 13.1
;IF ARG.0 & %200 /= 0
@BOX 14.1
;F2B14:
@BOX 16.1
;F2B16:
@BOX 17.1
;-1 => AT =>  CUR.A.TYPE.G
;TL.PL(%46, %24)
@BOX 18.1
;AT ! 8 => T
;IF ARG.0 & %F = 8 THEN %40 !> T FI
;SET.A.TYPE(T, AZ)
@BOX 21.1
; %21 => D.OP
@BOX 15.1
; %22 => D.OP
@BOX 22.1
;F2B22:
@BOX 23.1
;->NEXT.ARG
@BOX 24.1
;ADDRESS OF PROPS.T[AS[ARG.E.AP + 2]] => A
;MAKE($LO8, 1320, A) => CP
;TL.S.DECL(NIL.STR, %80, -1)
;MUTL.N.G => NAM + 1 => MUTL.N.G
;TL.ASS(NAM, -1)
;-1 => T
;WHILE CP^[1 +> T] /= 0 DO OD
;TL.C.LIT.S(%80, PART(CP,0,T-1))
;TL.ASS.VALUE(0,1)
;IF T & 7 -: 8 => T /= 8 THEN
   ;TL.CLIT.16(%80,SPACE.L)
   ;TL.ASS.VALUE(0,T)
;FI
;TL.ASS.END()
@BOX 25.1
;SET.A.TYPE(6, 0)
@BOX 26.1
;TL.BLOCK()
@BOX 27.1
;TL.I.PARAM(PROC.MUTL.NAME, TL.N,
            %800D ! MODE[AT]);
@BOX 28.1
;IF A.Z & %F = 2
@BOX 29.1
;SET.A.TYPE(AT ! %10, 2)
@BOX 30.1
;TL.PL(%20, MUTL.N.G + 1)
@BOX 31.1
;SET.A.TYPE(8 ! AT, 2)
@BOX 32.1
;TL.PL(%22, MUTL.N.G)
;TL.END.BLOCK()
@BOX 34.1
;IF A.Z & %10 /= 0
@BOX 35.1
;IF ET /= 7
@END
@TITLE FTN11.5.3(1,11)
@COL 11R-12R-13R-14R-26R-27C-28R-29C-18R-7R
@COL 1S-2R-4T-5R-34C-3T-6R-24T-25T-17T-15T-16R-9R-8R-10C
@ROW 11-2
@FLOW 2-4N-5-34
@FLOW 4Y-3N-6-24N-25N-17N-15N-16-9-8-10
@FLOW 3Y-10
@FLOW 24Y-26-27
@FLOW 25Y-28-29
@FLOW 15Y-7-10
@FLOW 11-12-24
@FLOW 13-14-24
@FLOW 17Y-18-9
@BOX 1.0
CODE PROC CALL/CONT
CHARACTER ARGUMENTS PASSED BY
REFN
@BOX 4.0
NOT INTRINSIC FN
LEN, LEX, OR INDEX
@BOX 5.0
CODE EXPR :11.3
LHS = IF FIRST ARG
RHS = IF SECOND ARG
@BOX 34.0
END
@BOX 2.0
EXPR
@BOX 3.0
CREATE DUMP AND COPY EXPR:11.19:
FAULTY?
@BOX 6.0
PL A = REF OF
DUMP STRING
@BOX 9.0
STACK PAR A
@BOX 10.0
END
@BOX 24.0
STATEMENT FN
@BOX 25.0
INTRINSIC FN
@BOX 26.0
PLANT A=> STATIC ARGUMENT
ADVANCE STAT FN ARG PTR
@BOX 27.0
END
@BOX 28.0
PLANT INTRINSIC FUNCTION CODE
@BOX 29.0
END
@BOX 11.0
SUBSTRING
@BOX 12.0
LOAD REFN INTO A:11.12:
WITH BOUND
@BOX 13.0
CONSTANT
CONSTANT NAME
VARIABLE
ARRAY EL
FN REFN
ARRAY
@BOX 14.0
LOAD REFN INTO A:11.12:
@BOX 17.0
CONSTANT
@BOX 18.0
NOTE = LENGTH
@BOX 15.0
SUBSTRING
@BOX 16.0
NOTE CHAR LENGTH
@BOX 7.0
PLANT STACK A
SAVING A
PLANT A = BND
PLANT STACK A
@BOX 8.0
PLANT STACK LENGTH
@BOX 1.1
@BOX 2.1
;F3.B2:
@BOX 4.1
;IF PK /= 7 OR INTR.FN = 0
@BOX 5.1
;CODE.EXPR(ARG.E.AP,STR.FN)
@BOX 34.1
;->NEXT.ARG
@BOX 3.1
;IF CREATE.CHAR.EXPR.DUMP(ARG.E.AP)=>T < 0
@BOX 6.1
;SET.A.TYPE(6,0) :: ??? JM 31-DEC-82
;TL.PL(%61, T)
;IF STR.FN /= 0 THEN
   ;TL.PL(STR.FN,%1004)
;FI
@BOX 9.1
;TL.PL(%41,%3000)
@BOX 10.1
;->NEXT.ARG
@BOX 24.1
;IF PK = 4
@BOX 25.1
;IF PK = 7
@BOX 26.1
;SET.A.TYPE(6,0) :: ??? JM 31-DEC-82
;TL.PL(%20,L.TL.NAME OF ST.FN.ARG.LP^)
;L.LINK2 OF ST.FN.ARG.LP^=>ST.FN.ARG.LP
@BOX 27.1
;->NEXT.ARG
@BOX 28.1
;CODE.INL.INTR(INTR.IN & %3F + AN - N)
@BOX 29.1
;->NEXT.ARG
@BOX 11.1
;F3.B11:
@BOX 12.1
;IF INTR.FN = 0 AND STR.FN /= 0 THEN
   ;SET.A.TYPE(6,0) :: ??? JM 31-DEC-82
;FI
;PL.LOAD.STR(STR.FN,ARG.E.AP)
@BOX 13.1
;F3.B13:
@BOX 14.1
;IF INTR.FN = 0 AND STR.FN /= 0 THEN
   ;SET.A.TYPE(6,0) :: ??? JM 31-DEC-82
;FI
;PL.LOAD.STR(STR.FN ! %80,ARG.E.AP)
@BOX 17.1
;IF ARG.0 & %F < 2
@BOX 18.1
;ADDRESS OF PROPS.T[AS[ARG.E.AP+2]] => A
;MAKE($LO8,4095,A)=>CP
;-1=>T
;WHILE CP^[1+>T] /= 0 DO OD
@BOX 15.1
;IF ARG.0  & %F = 11
@BOX 16.1
;LOC OF PROPS.T[AS[ARG.E.AP+2]] => ARG.LP
;L.LEN OF ARG.LP^ => T
@BOX 8.1
; SET.A.TYPE(3,1) :: ??? JM 31-DEC-82
; IF T >= 0 THEN
    ;TL.C.LIT.32(%44,T) :: ??? JM 31-DEC-82
    ;0 => T
; FI
;TL.PL(%22,0-T)
;TL.PL(%41,%3000)
@BOX 7.1
;TL.REG(2)
;TL.PL(%41,%3000)
;SET.A.TYPE(3,1)
;TL.PL(%41,%3000)
@END
@TITLE FTN11.5.4(1,10)
@COL 1S-2R
@COL 5R-3R-4F
@ROW 2-5
@FLOW 1-2-5-3-4
@BOX 1.0
CODE INL.INTR(PTR)
@BOX 2.0
DATAVECS OF
IN CODE SEQUENCES
@BOX 5.0
DATAVEC OF CODE
INDEXES
@BOX 3.0
PLANT MUTL CODE SEQUENCE
@BOX 4.0
END
@BOX 1.1
;PROC CODE.INL.INTR(P)
;$IN S,F,T,OP,FN, PR
@BOX 2.1
;DATAVEC CODE.SEQ($LO8)
%45 %43
%00
%00
%00
%00
%45 %43
%45 %00
%45 %00

%00
%02 %04 %64 %05 %46 %43 %22 %00
%45 %00
%61 %03 %02 %04 %67 %05 %52 %05
%00
%45 %10
%45 %53
%45 %53

%00
%45 %43
%45 %43
%45 %00
%45 %00
%45 %01
%45 %01
%45 %01

%45 %01
%51 %02
%00
%51 %02
%51 %02
%45 %93 %45 %00
%45 %93 %45 %01
%45 %83 %45 %00

%45 %83 %45 %01
%45 %03
%52 %02
%00
%00
%00
%00
%00

%00
%45 %01 %47 %01
%45 %01 %2B %02
%47 %01
%51 %12 %24 %02
%45 %00 %47 %01
%51 %12 %24 %02
END
@BOX 5.1
;LITERAL/$LO8
 P0=2,  P1=1,  P2=1,  P3=1,
 P4=1,  P5=2,  P6=2,  P7=2,
 P8=1,  P9=8, P10=2, P11=8,
P12=1, P13=2, P14=2, P15=2,
P16=1, P17=2, P18=2, P19=2,
P20=2, P21=2, P22=2, P23=2,
P24=2, P25=2, P26=1, P27=2,
P28=2, P29=4, P30=4, P31=4,
P32=4, P33=2, P34=2, P35=1,
P36=1, P37=1, P38=1, P39=1,
P40=1, P41=4, P42=4, P43=2,
P44=4, P45=4, P46=4
;LITERAL/$LO8
C0=0, C1=C0+P0, C2=C1+P1, C3=C2+P2,
C4=C3+P3, C5=C4+P4, C6=C5+P5, C7=C6+P6,
C8=C7+P7, C9=C8+P8, C10=C9+P9, C11=C10+P10,
C12=C11+P11, C13=C12+P12, C14=C13+P13, C15=C14+P14,
C16=C15+P15, C17=C16+P16, C18=C17+P17, C19=C18+P18,
C20=C19+P19, C21=C20+P20, C22=C21+P21, C23=C22+P22,
C24=C23+P23, C25=C24+P24, C26=C25+P25, C27=C26+P26,
C28=C27+P27, C29=C28+P28, C30=C29+P29, C31=C30+P30,
C32=C31+P31, C33=C32+P32, C34=C33+P33, C35=C34+P34,
C36=C35+P35, C37=C36+P36, C38=C37+P37, C39=C38+P38,
C40=C39+P39, C41=C40+P40, C42=C41+P41, C43=C42+P42,
C44=C43+P43, C45=C44+P44, C46=C45+P45, C47=C46+P46

;DATAVEC CODE.P($LO8)
C0 C1 C2 C3 C4 C5 C6 C7
C8 C9 C10 C11 C12 C13 C14 C15
C16 C17 C18 C19 C20 C21 C22 C23
C24 C25 C26 C27 C28 C29 C30 C31
C32 C33 C34 C35 C36 C37 C38 C39
C40 C41 C42 C43 C44 C45 C46 C47
END
@BOX 3.1
;CODE.P[P] => S
;CODE.P[P+1] => F
;WHILE 1+S < F DO
;CODE.SEQ[S+1] => T
   ;IF CODE.SEQ[S] => FN = %46
       OR FN = %45  OR FN = %51 OR FN = %52 THEN
       ;IF T & %80 /= 0 THEN
          ;2 => PR
       ;ELSE IF T & %40 /= 0 THEN
          ;N0 ->> 5 & 7 => PR
       ;ELSE
          ;DEF.PR[T & %F] => PR
       ;FI FI
      ;MUTL.TYPE(T & %F, PR) => OP
      ;IF T & %10 /= 0 THEN
         ;%4000 !> OP
      ;FI
      ;OP => CUR.A.TYPE.G
      ;(IF FN > %46 THEN %C ELSE 0) => CUR.FN.EX.G
      ;T=>C.FTN.TYPE.G
      ;PR=>C.FTN.PR.G
   ;ELSE
      ;ALTERNATIVE T FROM
         ;%1004 => OP
         ;%3000 => OP
         ;%1003 => OP
         ;BEGIN
  ;TL.S.DECL(NIL.STR,%80,1)
  ;MUTL.N.G=>OP+1=>MUTL.NG
  ;TL.PL(%61,OP)
  ;TL.PL(%45, %80)
  ;-1 => CUR.A.TYPE.G
  ;TL.PL(%02, TL.ZERO.G)
  ;TL.PL(%64, 0)
  ;TL.PL(%20,%1004)
         ;END
         ;TL.ZERO.G => OP
         ;0 => OP
      ;END
   ;FI
   ;TL.PL(FN,OP)
   ;2 +> S
;OD
@BOX 4.1
;END
@END
@TITLE FTN11.5.5(1,11)
@COL 10C-11R
@COL 1S-2C-3T-4R-5R-6R-7R-8R-9C
@ROW 10-2
@FLOW 2-3N-4-5-6-7-8-9
@FLOW 3Y-9
@FLOW 10-11-5
@BOX 1.0
CODE PROC.CALL/ CONT
PASS CHARACTER AS LOGICAL64 VALUE
ONLY USED FOR INTERFACING NON-FORTRAN PROCEDURES
@BOX 2.0
EXPR
@BOX 3.0
CREATE DUMP AND COPY EXPR TO IT
[FTN11.19]
FAULTY?
@BOX 4.0
PLANT A = REF OF DUMP STRING
@BOX 5.0
START MUTL BLOCK
@BOX 6.0
DECLARE PTR VARIABLE
DECLARE LIMIT, CNT VARIABLE
DECLARE LABEL SPECS L1, L2
@BOX 7.0
PLANT
A => PTR
A = BOUND OF A
A  =>  LIMIT
B = -1
B => CNT
AMODE = LOGICAL 64
A = 0
L1:
B = 1
B +> CNT
IF B >= LIMIT, -> L2
D = PTR
SEL EL
A <<- 8
A ! D[]
->L1
L2:
STACK A
@BOX 8.0
END MUTL BLOCK
@BOX 9.0
END
@BOX 10.0
CONSTANT
CONSTANT NAME
VARIABLE
ARRAY EL
FN REFN
ST FN REFN
SUBSTRING
@BOX 11.0
LOAD REFN WITH BOUND IN B
INTO A [FTN11.12]
@BOX 1.1
::FTN11.5.5
@BOX 2.1
;F5B2:
@BOX 3.1
;IF CREATE.CHAR.EXPR.DUMP(ARG.E.AP) => N < 0
@BOX 4.1
;SET.A.TYPE(6,0) :: ??? JM 31-DEC-82
;TL.PL(%21, N)
@BOX 5.1
;TL.BLOCK()
@BOX 6.1
;TL.S.DECL(NIL.STR, %83, 0)
;TL.S.DECL(NIL.STR, %44, 0) :: ??? JM 31-DEC-82
;TL.S.DECL(NIL.STR, %44, 0) :: ??? JM 31-DEC-82
;TL.LABEL.SPEC(NIL.STR, 0)
;TL.LABEL.SPEC(NIL.STR, 0)
@BOX 7.1
;TL.REG(2)
;TL.PL(%20, MUTL.NG)
;SET.A.TYPE(%33,1)
;TL.PL(%20, MUTL.NG + 1)
;TL.PL(1,TL.ONE.G)
;TL.PL(0, MUTL.NG + 2)
;TL.PL(%46, %9C)
;TL.PL(%22, TL.ZERO.G)
;TL.LABEL(MUTL.NG + 3)
;TL.PL(2, TL.ONE.G)
;TL.REG(1)
;TL.PL(%18, MUTL.NG + 2)
;TL.REG(1)
;TL.PL(%F, MUTL.NG + 1)
;TL.PL(%4B, MUTL.NG + 4)
;TL.PL(%62, MUTL.NG)
;TL.PL(%64,0)
;TL.C.LIT.16(%44, 8)
;TL.PL(%26,0)
;TL.PL(%25, %1004)
;TL.PL(%4F, MUTL.NG + 3)
;TL.LABEL(MUTL.NG + 4)
;TL.PL(%41, %3000)
@BOX 8.1
;TL.END.BLOCK()
@BOX 9.1
;->NEXT.ARG
@BOX 10.1
;F5.B10:
@BOX 11.1
;SET.A.TYPE(6,0) :: ??? JM 31-DEC-82
;PL.LOAD.STR(%A1, ARG.E.AP)
@END
@TITLE FTN11.6(1,11)
@COL 14R-15R-16T-17R-20R
@COL 1S-2T-3R-4T-5T-6R-7R-8T-9R-10T-11T-12R-13F
@COL 18R-19R
@ROW 14-3
@ROW 15-6
@ROW 5-18
@ROW 20-12
@FLOW 1-2N-3-4N-5N-6-7-8N-9-10N-11N-12-13
@FLOW 2Y-14-5Y-15-16N-17-7
@FLOW 16Y-7
@FLOW 8Y-10
@FLOW 4Y-18-19-12
@FLOW 10Y-20-13
@FLOW 11Y-13
@BOX 1.0
SET.A.TYPE(TYPE, PRECISION)
P1 Bit 0-2 Fortran type
   Bit 3 = 1 Pointer to Fortran type
   Bit 4 = 1 ACONV AECONV order
   Bit 5 = 1 set kind bit, force CONV, MODE
   Bit 6 = 1 Array type needed
@BOX 2.0
CONVERT?
@BOX 3.0
SET FN TO AMODE
@BOX 4.0
CHAR ARRAY MODE?
@BOX 5.0
COMPLEX OR CHAR?
@BOX 6.0
SET MUTL SIZE ENCODING
@BOX 7.0
CREATE MUTL TYPE ENCODING
@BOX 8.0
NO ARRAY MODE NEEDED?
@BOX 9.0
SET ARRAY TYPE
@BOX 10.0
Set kind bit?
@BOX 11.0
MODE CHANGE NOT REQUIRED?
@BOX 12.0
PLANT A(E)MODE/CONV
SET CUR.A.TYPE
@BOX 13.0
END
@BOX 14.0
SET FN TO ACONV
@BOX 15.0
SET MUTL SIZE INFO TO ZERO
@BOX 16.0
ACONV?
@BOX 17.0
SELECT EXTENDED A FUNCTION
@BOX 18.0
SET CUR DIMENSION
@BOX 19.0
SET MUTL TYPE ENCODING
@BOX 20.0
SET KIND BIT
@BOX 1.1
;PROC SET.A.TYPE(T, PR)
;$IN FN, MT, S, CUR.FN
@BOX 2.1
;0 => CUR.FN
;T => S & %F => T
;S & %4F => C.FTN.TYPE.G
;PR => C.FTN.PR.G
;IF S & %10 /= 0
@BOX 3.1
;%46 => FN
@BOX 4.1
;IF T = 14
@BOX 5.1
;IF T & 7 = 2 OR T & 7 = 5
@BOX 6.1
;PR.T[PR] - 1 <<- 2 => MT
@BOX 7.1
;A.MODE[T] !> MT
@BOX 8.1
;IF S & %40 = 0
@BOX 9.1
; 2 !> MT
@BOX 10.1
;IF S & %20 /= 0
@BOX 11.1
;IF [MT = CUR.A.TYPE.G AND CUR.FN=CUR.FN.EX.G]
@BOX 12.1
;TL.PL(FN, MT)
@BOX 13.1
;MT => CUR.A.TYPE.G
;CUR.FN => CUR.FN.EX.G
;END
@BOX 14.1
;%45 => FN
@BOX 15.1
;0 => MT
@BOX 16.1
;IF [S & %10 /= 0 AND T = 5] OR T > 7
@BOX 17.1
;%C => CUR.FN +> FN
@BOX 18.1
;TL.C.LIT.16(%44,CUR.A.DIM.G)
@BOX 19.1
;%82 => MT
@BOX 20.1
;TL.PL(FN, MT ! %4000)
@END
@TITLE FTN11.7(1,10)
@COL 11T-12R-13C
@COL 1S-2T-3T-14T-4T-5T-6R-7F
@COL 8R-9R-10C
@ROW 4-8
@ROW 11-6
@FLOW 1-2N-3N-14N-4N-5N-6-7
@FLOW 3Y-8-10
@FLOW 4Y-9-10
@FLOW 14Y-11
@FLOW 5Y-11N-12-13
@FLOW 11Y-7
@FLOW 2Y-10
@BOX 1.0
EVAL CONST EXPR(EXPR.INDEX,TYPE)CONST.ADDR
@BOX 2.0
REDUCE EXPR:11.2:
FAULTY?
@BOX 3.0
EXPR NOT A CONSTANT?
@BOX 4.0
CONSTANT NOT OF A
COMPATABLE TYPE?
@BOX 5.0
CONSTANT OF SAME TYPE?
@BOX 6.0
CHANGE TYPE OF CONSTANT:11.1:
@BOX 7.0
END-CONST^
@BOX 8.0
FAULT
@BOX 9.0
FAULT
@BOX 10.0
END--1
@BOX 11.0
NOT CHAR CONST
@BOX 12.0
CREATE CHAR CONST ENTRY
@BOX 13.0
END CONST^
@BOX 14.0
CONSTANT OF ANY TYPE ALLOWED?
@BOX 1.1
;PROC EVAL.CONST.EXPR(AP,T)
;$IN EK,I,C,ET,K
;ADDR CA
;ADDR CONST.PROP CP
;LITERAL/ADDR CONST.PROP NIL.C=
;DATAVEC VALID.CONV($LO8)
0  0  1  0  1  1
0  0  1  0  1  1
0  1  0  0  1  1
0  0  0  0  1  1
1  1  1  1  0  1
1  1  1  1  1  0
END
;T & %18 => C
;T & 7 =>T
@BOX 2.1
;IF REDUCE.EXPR(AP) => EK & %F => ET = %F
@BOX 3.1
;IF AS[AP] & %1F => K /= %10 /= %11
@BOX 4.1
;IF C /=0 AND T /= ET
   OR VALID.CONV[T*6+ET] /= 0
@BOX 5.1
;IF T = ET
@BOX 6.1
;IF K = %11 THEN
   ;COPY.CONST(CONST OF PROPS.T[I],0) => CONST OF PROPS.T[I]
;FI
;CHANGE.CONST.TYPE(CONST OF PROPS.T[I],ET,T)
@BOX 7.1
;CONST OF PROPS.T[I] => EVAL.CONST.EXPR
;END
@BOX 8.1
;FAULT(99,1)
@BOX 9.1
;FAULT(100,1)
@BOX 10.1
;NIL.C => EVAL.CONST.EXPR
;EXIT
@BOX 11.1
;IF ET /= 5
@BOX 12.1
;MAKE.CONST.PROP(LINE.SPACE) => CP
;ADDRESS OF PROPS.T[I] => CA
;MAKE($LO8,4095,CA) => CH.CONST OF CP^
@BOX 13.1
;CP => EVAL.CONST.EXPR
;EXIT
@BOX 14.1
;AS[AP+2] => I :: ??? 5-JAN-83
;IF C = %10
@END
@TITLE FTN11.8(1,10)
@COL 1S-2T-3R-4R-5F
@COL 6R
@ROW 3-6
@FLOW 1-2N-3-4-5
@FLOW 2Y-6-4
@BOX 1.0
COPY CONSTANT(CONST.ADDR,SPACE)CONST.ADDR
@BOX 2.0
NEW CONSTANT ENTRY
IN LINE SPACE
@BOX 3.0
MAKE CONSTANT IN
LOCAL SPACE
@BOX 4.0
COPY CONSTANT
@BOX 5.0
END
@BOX 6.0
MAKE CONSTANT IN
LINE SPACE
@BOX 1.1
;PROC COPY.CONST(CP,S)
;ADDR CONST.PROP CP1

@BOX 2.1
;IF S=0
@BOX 3.1
;MAKE.CONST.PROP(LOCAL.SPACE) => CP1
@BOX 4.1
;CP^ => CP1^
@BOX 5.1
;CP1 => COPY.CONST
;END
@BOX 6.1
;MAKE.CONST.PROP(LINE.SPACE) => CP1
@END
@TITLE FTN11.9(1,11)
@COL 8C-9R-15C-16R-17C-18R
@COL 1S-20T-21T-2R-3R-4C-5R-10R-6F
@COL 22R-23T-24R-25R-26R-11C-12R-13R-14C
@FLOW 1-20N-21N-2-3
@FLOW 8-9-10
@FLOW 15-16-10
@FLOW 17-18-10
@FLOW 4-5-10-6
@FLOW 11-12-13-14
@FLOW 20Y-22-21Y-23N-24-25-10
@FLOW 23Y-26-13
@BOX 1.0
DECL ARITH CONST(CONST.ADDR,TYPE)MUTL.NAME
TYPE BITS 0-3 FORTRAN TYPE
BIT 4= 1 MEANS MUTL NAME REQUIRED
BIT 8= 1 MEANS CONSTANTS IN HOLLERITH FORM
@BOX 2.0
GET MUTL TYPE
@BOX 3.0
SWITCH ON FORTRAN TYPE
@BOX 4.0
INTEGER REAL DP
@BOX 5.0
DECLARE C.LIT WITH
MOST APPROPRIATE PROC
IE TL.C:LIT 32,64,128
@BOX 6.0
END
@BOX 8.0
LOGICAL
@BOX 9.0
DECLARE VALUE
@BOX 15.0
REAL PART OF
COMPLEX
@BOX 16.0
DECLARE VALUE
@BOX 17.0
IMAG PART OF
COMPLEX
@BOX 18.0
DECLARE VALUE
@BOX 10.0
ALLOCATE MUTL NAME IF
REQUESTED
@BOX 11.0
COMPLEX
@BOX 12.0
ASSIGN VALUES TO
COMPLEX COMPONENTS
@BOX 13.0
END ASSIGNING
@BOX 14.0
END
@BOX 20.0
NO COMPLEX?
@BOX 21.0
CONSTANT A HOLLERITH?
@BOX 22.0
DEFINE INCODE COMPLEX
VARIABLE
INIT ASSIGNMENT
@BOX 23.0
COMPLEX?
@BOX 24.0
SET MUTL TYPE
@BOX 25.0
DECLARE HOLL STRING
VALUE
@BOX 26.0
ASSIGN VALUES TO
COMPLEX COMPONENTS
@BOX 1.1
;PROC DECL.ARITH.CONST(CP,T)
;$LO32 L
; ADDR [$LO8] HP
;$IN MT,Z,ST
;LITERAL/ADDR[$LO8] NIL.STR =
;0=>DECL.ARITH.CONST
@BOX 2.1
;MUTL.TYPE(T,DEF.PR[T])=>MT
@BOX 3.1
;SWITCH  T \ D.R,D.DP,D.C,D.I,D.L,D.C.R,D.C.I
@BOX 4.1
@BOX 5.1
;DR:
;TL.C.LIT.32(MT,REAL.CONST OF CP^=>L)
;->B10
;DI:
;TL.C.LIT.32(MT,INT.CONST OF CP^)
;->B10
;DDP:
;TL.C.LIT.64(MT,DP.CONST OF CP^)
@BOX 6.1
;END
@BOX 8.1
;DL:
@BOX 9.1
;TL.C.LIT.32(MT,LOG.CONST OF C.P^)
@BOX 15.1
;D.C.R:
@BOX 16.1
;TL.C.LIT32(C.COMP.ACC.T.L,R.COMP.CONST OF CP^=>L)
@BOX 17.1
;D.C.I:
@BOX 18.1
;TL.C.LIT32(C.COMP.ACC.T.L,I.COMP.CONST OF CP^=>L)
@BOX 10.1
;B10:
;IF ST & %10 /= 0 THEN
   ;TL.LIT(NIL.STR,0)
   ;MUTL.N.G=>DECL.ARITH.CONST+1=>MUTL.N.G
;FI
@BOX 11.1
;D.C:
@BOX 12.1
;TL.C.LIT.32(C.COMP.ACC.T.L,R.COMP.CONST OF CP^=>L)
;TL.ASS.VALUE(0,1)
;TL.C.LIT.32(C.COMP.ACC.T.L,I.COMP.CONST OF CP^=>L)
;TL.ASS.VALUE(0,1)
@BOX 13.1
;TL.ASS.END()
@BOX 14.1
;EXIT
@BOX 20.1
;IF T=>ST & 7 => T = 2
@BOX 21.1
;IF ST & %100 /= 0
@BOX 22.1
;TL.S.DECL(NIL.STR,%108,-4096)
;TL.ASS(MUTL.NG=>DECL.ARITH.CONST,-1)
;1+>MUTL.NG
@BOX 23.1
;^H.CONST OF CP^ => HP
;IF T = 2
@BOX 24.1
;MUTL.TYPE(T,H.PR OF CP^)=>MT
;MT ->> 2 & %F => Z
@BOX 25.1
;TL.C.LIT.S(MT ! 2, PART(HP,0,Z))
@BOX 26.1
;TL.C.LIT.S(C.COMP.ACC.T.L,PART(HP,0,3))
;TL.ASS.VALUE(0,1)
;TL.C.LIT.S(C.COMP.ACC.T.L,PART(HP,4,7))
;TL.ASS.VALUE(0,1)
@END
@TITLE FTN11.10(1,10)
@COL 1S-2R-3R-4R-5F
@FLOW 1-2-3-4-5
@BOX 1.0
DECL.CHAR.CONST(CONST.ADDR)MUTL.NAME
@BOX 2.0
GET SIZE
@BOX 3.0
DECLARE AS VECTOR OF BYTES
@BOX 4.0
ASSIGN VALUE
@BOX 5.0
END
@BOX 1.1
;PROC DECL.CHAR.CONST(PI)
;ADDR [$LO8] P
;ADDR A
;$IN I
;LITERAL/ADDR[$LO8] NIL.STR =
@BOX 2.1
;ADDRESS OF PROPS.T[PI] => A
;MAKE($LO8,4095,A) => P
;-1 => I
;WHILE P^[1+>I] /= 0 DO OD
@BOX 3.1
;TL.S.DECL(NIL.STR,%80,-1)
@BOX 4.1
;TL.ASS(MUTL.N.G=>DECL.CHAR.CONST,-1)
;1+>MUTL.N.G
;TL.C.LIT.S(%80,PART(P,0,I-1))
;TL.ASS.VALUE(0,1)
;TL.ASS.END()
@BOX 5.1
;END
@END
@TITLE FTN11.11(1,11)
@COL 1S-2T-3T-4T-5R-7T-8R-10R-11R-22T-20T-21R-17F
@COL 12T-13R-18T-15R-16R-23R
@ROW 4-12
@ROW 21-23
@ROW 8-16
@FLOW 1-2N-3N-4N-5-7N-8-10-11-22N-20N-21-17
@FLOW 20Y-17
@FLOW 2Y-7
@FLOW 3Y-12N-13-18N-15-7
@FLOW 22Y-23-17
@FLOW 12Y-18Y-7
@FLOW 4Y-7
@FLOW 7Y-16-10
@BOX 1.0
PL ARITH FN(FN,AP)
@BOX 2.0
NOT LOAD FN
@BOX 3.0
A LOAD
@BOX 4.0
B NOT IN USE
@BOX 5.0
PLANT STACK B
UPDATE EXPR NODE TO
SAY OPERAND OF B IN USE
@BOX 7.0
DUMMY ARGUMENT?
@BOX 8.0
NOTE D=REF REQUIRED
TO LOAD D
@BOX 10.0
GET TL.NAME OF OPERAND
FROM ANAL RECORD
SET TYPE
@BOX 11.0
PROCESS ACCORDING TO OPERAND KIND
VARIABLE, CONST, CONST.NAME : 11.11.1:
ARRAY.EL, T : 11.11.1:
FN.REF : 11.11.2:
OTHERS : 11.11.1:
@BOX 12.0
A NOT IN USE?
@BOX 13.0
PLANT STACK A
UPDATE EXPR NODE TO SAY
OPERAND ON STACK
@BOX 18.0
FN REFN?
@BOX 15.0
SET A.TYPE : 11.6:
@BOX 16.0
NOTE D=REQUIRED TO
LOAD D
@BOX 17.0
END
@BOX 20.0
NOT EQUIVALENCE FN
@BOX 21.0
PLANT A & 1
@BOX 22.0
LOAD FUNCTION
@BOX 23.0
SET UP REG IN USE INFO
@BOX 1.1
;PROC PL.ARITH.FN(FN,AP)
;$IN OLD.A.TYPE, OLD.A.DIM, Z, STK.Z, B.Z, OLD.FN.EX
;$IN N0, STK.T, DFN, N, FL, T, F, R, TP, OLD.A.AP
;$IN B.REG.TYPE
@BOX 2.1
;AS[AP]=>N0 ->> 5 & 7 => Z
;IF FN & %1F /= 2
@BOX 3.1
;IF FN = %22
@BOX 4.1
;IF B.AP.G < 0
@BOX 5.1
;TL.PL(%47,%2000)
;1+>AS[B.AP.G]
;-1 => B.AP.G
@BOX 7.1
;IF AS[AP] => N0 & %200 /= 0
@BOX 8.1
;%61 => D.FN
@BOX 10.1
;AS[AP+1] => N
;N0 ->> 12 & 7 => T
@BOX 11.1
;SWITCH N0 & %F\
F1B27, F1B11, F1B14, F1B2,
F2B2, F2B2, F2B2, F2B2,
F1B23, F1B23, F1B23, F1B23,
F1B23, F1B22, F1B20, F1B23
#FTN11.11.1
;->AROUND
#FTN11.11.2
;AROUND:
@BOX 12.1
;IF A.AP.G < 0
@BOX 13.1
;TL.PL(%47,%3000)
;1+>AS[A.AP.G]
;-1 => A.AP.G
@BOX 18.1
;IF N0 & %F >3 <8
@BOX 15.1
;SET.A.TYPE(N0 ->> 12 & 7, Z)
@BOX 16.1
;%62 => D.FN
@BOX 17.1
;END
@BOX 20.1
;IF FN & %1F /= %E
@BOX 21.1
;TL.PL(FN & %E0 ! 4, TL.ONE.G)
@BOX 22.1
;IF FN & %1F = 2
@BOX 23.1
;AS[AP] & %FFE0 ! %1C => AS[AP]
;IF FN & %20 /= 0 THEN
   ;AP => A.AP.G
;ELSE
   ;AP => B.AP.G
;FI
@END
@TITLE FTN11.11.1(1,11)
@COL 11C-12R-14C-15T-16R-20C-21R-22C-26R-27C-28R
@COL 1S-2C-3T-4R-5R-6R-7T-8R-9R-10F
@COL 18T-19R-23C-24R-25C
@ROW 11-2
@ROW 4-18
@FLOW 2-3N-4-5-6-7N-8-9-10
@FLOW 3Y-18N-19-4
@FLOW 18Y-4
@FLOW 7Y-9
@FLOW 11-12-10
@FLOW 14-15N-16-9
@FLOW 15Y-12
@FLOW 20-21-12
@FLOW 23-24-25
@FLOW 22-26-12
@FLOW 27-28-12
@BOX 1.0
PLANT ARITH FN/CONT
@BOX 2.0
ARRAY EL
@BOX 3.0
B FN
@BOX 4.0
CODE SUBSCRIPTS : 11.4:
@BOX 5.0
PL LOAD D=/D=REF TLNAME
@BOX 6.0
PL SEL EL
@BOX 7.0
B NOT STACKED?
@BOX 8.0
SET.B.TYPE [11.28]
PL B=STACK
@BOX 9.0
PL FN D[]
NOTE B NOT IN USE
@BOX 10.0
END
@BOX 11.0
CONST NAME
@BOX 12.0
PL FN NAME
@BOX 14.0
VARIABLE
@BOX 15.0
NOT DUMMY ARGUMENT?
@BOX 16.0
PLANT D=
@BOX 18.0
B=
@BOX 19.0
STACK B
NOTE STACKED
@BOX 20.0
T
@BOX 21.0
SET NAME
NOTE T NOT IN USE
@BOX 22.0
STK
@BOX 26.0
SET NAME
@BOX 27.0
CONST
@BOX 28.0
DECL ARITH CONST
SET NAME=0
@BOX 23.0
OTHERS
@BOX 24.0
FAULT
@BOX 25.0
END
@BOX 1.1
@BOX 2.1
;F1.B2:
@BOX 3.1
;-2=>FL
;IF FN & %E0 = 0
@BOX 4.1
;CODE.SUBSCRIPTS(AS[AP+2],AS[AP+4],0)
@BOX 5.1
;TL.PL(DFN,N)
@BOX 6.1
;TL.PL(%64,0)
@BOX 7.1
;IF FL < 0
@BOX 8.1
;SET.B.TYPE(FL)
;TL.PL(2,%1003)
@BOX 9.1
;TL.PL(FN,%1004)
;-1=>B.AP.G
@BOX 10.1
::END
@BOX 11.1
;F1B11:
@BOX 12.1
;TL.PL(FN,N)
@BOX 14.1
;F1B14:
@BOX 15.1
;IF N0 & %200 = 0
@BOX 16.1
;TL.PL(%62,N)
@BOX 20.1
;F1B20:
@BOX 21.1
;TL.REL.T.FN[N0->> 5 & 7] => N
;-1=>T.AP.G
@BOX 22.1
;F1B22:
@BOX 26.1
; %1003 => N
@BOX 27.1
;F1B27:
@BOX 28.1
;DECL.ARITH.CONST(CONST OF PROPS.T[AS[AP+2]],N0&%100!T)=>N
@BOX 18.1
;IF FN = 2
@BOX 19.1
;TL.PL(%47,%2000)
;CUR.B.TYPE.G=>FL
@BOX 23.1
;F1B23:
@BOX 24.1
;FAULT(401,6)
@BOX 25.1
;EXIT
@END
@TITLE FTN11.11.2(1,11)
@COL 1S-2C-16R-11T-3T-4R-5R-6T-7R-8T-14T-15R-9R-10F
@COL 12R-13R
@ROW 3-12
@FLOW 2-16-11N-3N-4-5-6N-7-8N-14N-15-9-10
@FLOW 3Y-5
@FLOW 6Y-8Y-10
@FLOW 11Y-12-13-3
@FLOW 14Y-9
@BOX 1.0
PL ARITH FN/CONT
@BOX 2.0
FN REF
@BOX 11.0
B FN AND A IN USE
NOTE CURRENT A TYPE
NOTE A TYPE
@BOX 3.0
REGISTER OF FN DOES NOT NEED PRESERVING
@BOX 4.0
STACK A/B
NOTE A TYPE STACKED
@BOX 5.0
CODE.PROC.CALL : 11.5:
@BOX 6.0
CURRENT REG IS A
@BOX 7.0
SET B PRECISION TO A PRECISION
PL A => B
CONVERT B TYPE IF NECESSARY
@BOX 8.0
LOAD A OR B FUNCTION
@BOX 9.0
PL B/A REV.FN STACK
REVERSE TEST INFO OF NODE
@BOX 10.0
RESET A TYPE AND RELOAD A
IF STACKED IN BOX 12
END
@BOX 12.0
STACK A
@BOX 13.0
NOTE A USE AND
RESET A USE
@BOX 14.0
ITEM ON STACK NOT OF GREATER PRECISION
@BOX 15.0
PL A CONV
@BOX 1.1
@BOX 16.1
;CUR.B.TYPE.G => B.Z
@BOX 2.1
;F2.B2:
;FN & %1F => F
;FN & %E0 => R
@BOX 11.1
;0 => OLD.A.AP
;CUR.A.TYPE.G => OLD.A.TYPE
;CUR.FN.EX.G =>OLD.FN.EX
;CUR.A.DIM.G => OLD.A.DIM
;C.FTN.TYPE.G => STK.T
;C.FTN.PR.G => STK.Z
;IF  R  =0 AND A.AP.G > 0
@BOX 3.1
;IF F =2
@BOX 4.1
;IF R /= 0 THEN
   ;%3000 => TP
   ;-1=>A.AP.G
;ELSE
   ;%2000 => TP
  ;-1=>B.AP.G
;FI
;TL.PL(%47,TP)
@BOX 5.1
;CODE.PROC.CALL(AP)
@BOX 6.1
;IF R /= 0
@BOX 7.1
;SET.B.TYPE (C.FTN.PR.G)
;TL.PL(2,%3000)
;IF B.Z /= C.FTN.PR.G THEN
    SET.B.TYPE (B.Z ! %10)
 FI
@BOX 8.1
;IF F =2
@BOX 9.1
;TL.PL(REV.FN[F] ! R,%1003)
@BOX 10.1
;IF R=0 THEN
;IF OLD.A.TYPE /= CUR.A.TYPE.G OR
    OLD.FN.EX /= CUR.FN.EX.G THEN
      ;OLD.A.DIM => CUR.A.DIM.G
      ;SET.A.TYPE(STK.T,STK.Z)
;FI
;IF OLD.A.AP > 0 THEN
    ;TL.PL(%22,%1003)
    ;OLD.A.AP => A.AP.G
;ELSE
    ;-1 => A.AP.G
;FI
 FI
 ::END
@BOX 12.1
;TL.PL(%47,%3000)
@BOX 13.1
;A.AP.G => OLD.A.AP
;-1=>A.AP.G
@BOX 14.1
;IF RANK[T*5+(STK.T&7)]=>FL=2 THEN
    STK.Z - Z => FL FI
;IF FL =< 0 OR R = 0
@BOX 15.1
;SET.A.TYPE(%10 ! STK.T,STK.Z)
@END
@TITLE FTN11.12(1,11)
@COL 17R
@COL 1S-2T-3R-4T-5R-6R-7C-8R-9T-11R-12T-13R-15R-16F
@COL 19R-20C-21R-25C-26R
@ROW 17-3
@ROW 5-19
@ROW 7-20
@FLOW 1-2N-3-4N-5-6
@FLOW 2Y-17-15-16
@FLOW 4Y-19-6
@FLOW 7-8-9N-11-12N-13-15
@FLOW 9Y-12Y-15
@FLOW 20-21-9
@FLOW 25-26-15
@BOX 1.0
PL.LOAD.STR(MODE,AP)
@BOX 2.0
UN=NAMED CONSTANT?
@BOX 3.0
GET TLNAME
@BOX 4.0
DUMMY ARGUMENT?
@BOX 5.0
SET D LOAD FN TO D = REF
@BOX 6.0
SWITCH ON OPERAND KIND
@BOX 7.0
VARIABLE
ARRAY
CONSTANT
@BOX 8.0
PLANT LOAD D
@BOX 9.0
LIMIT NOT REQUIRED
OR ARRAY?
@BOX 11.0
SET B TYPE=INT16
PLANT B = CHAR LENGTH - 1
PLANT LIMIT
NOTE B OUT OF USE
@BOX 12.0
NO SUBSTRING SPECIFIER
@BOX 13.0
PROCESS SUBSTRING:11.12.1:
@BOX 15.0
PLANT LHS OR RHS A=
IF LOAD REQUESTED
@BOX 16.0
END
@BOX 17.0
DECLARE BIG LITERAL
PLANT D = REF BIG LIT
@BOX 19.0
SET D LOAD FN
TO D =
@BOX 20.0
ARRAY EL
@BOX 21.0
LOAD D AND B FOR
ARRAY EL:11.20:
PLANT BASE
NOTE B OUT OF USE
@BOX 25.0
FN REFN
@BOX 26.0
CODE PROC CALL:11.5:
@BOX 1.1
;PROC PL.LOAD.STR(M,AP)
;$IN N0,AP1,K,N,D.FN,SK,CU,CL,L,SAP,T
;ADDR CONST.PROP CP
;ADDR LOCAL.PROP LP
@BOX 2.1
;IF AS[AP] => N0 & %F => K = 0
@BOX 3.1
;AS[AP+1] => N
@BOX 4.1
;IF N0 & %200 /= 0
@BOX 5.1
;%61 => D.FN
@BOX 6.1
;IF K = 11 THEN
   ;IF N0 & %400 /= 0 THEN
      ;3 => K
   ;ELSE
      ;2 => K
   ;FI
;FI
;SWITCH K - 1\
B7,B7,B20,B25,B25,B25,B25,B7
@BOX 7.1
;B7:
@BOX 8.1
;TL.PL(D.FN,N)
@BOX 9.1
;IF M & %80 /= 0 OR K = 8
@BOX 11.1
;SET.B.TYPE(1)
;LOC OF PROPS.T[AS[AP+2]] => LP
;IF L.LEN OF LP^ => L >= 0 THEN
   ;TL.C.LIT.16(%44,L-1)
   ;TL.PL(2,0)
;ELSE
   ;TL.PL(2,0-L)
   ;TL.PL(9,TL.ONE.G)
;FI
;TL.PL(%67,0)
;-1 => B.AP.G
@BOX 12.1
;IF N0 & %800 = 0
@BOX 13.1
#FTN11.12.1
@BOX 15.1
;IF M & %3F /= 0 THEN
   ;TL.PL(M & %3F,%1004)
;FI
@BOX 16.1
;END
@BOX 17.1
;TL.PL(%61,DECL.CHAR.CONST(AS[AP+2]))
@BOX 19.1
;%62 => D.FN
@BOX 20.1
;B20:
@BOX 21.1
;LOAD.REGS.FOR.CHAR.ARRAY.EL.NODE(AP)
;TL.PL(%66,STR.ARR.BASE.OP.L)
;-1 => B.AP.G
@BOX 25.1
;B25:
@BOX 26.1
;CODE.PROC.CALL(AP)
@END
@TITLE FTN11.12.1(1,11)
@COL 30R-31R
@COL 1S-2T-3R-4T-5T-6T-7R-28R-10R-11T-12R-14T-15T-16T-17R-29R-20R-21F
@COL 23R-26N-25R-27N
@ROW 30-6
@ROW 31-16
@ROW 7-23
@ROW 10-26
@ROW 17-25
@ROW 20-27
@FLOW 1-2N-3-4N-5N-6N-7-28-10-11
@FLOW 11N-12-14N-15N-16N-17-29-20-21
@FLOW 2Y-11
@FLOW 4Y-30-7
@FLOW 5Y-11
@FLOW 6Y-23-26-11
@FLOW 11Y-21
@FLOW 14Y-31-17
@FLOW 15Y-21
@FLOW 16Y-25-27-21
@BOX 1.0
PROCESS SUBSTRING
@BOX 2.0
UPPER SPECIFIER ABSENT?
@BOX 3.0
REDUCE EXPR : 11.2:
@BOX 4.0
SPECIFIER NOT A CONSTANT?
@BOX 5.0
SPECIFIER SAME AS UPPER LIMIT?
@BOX 6.0
SPECIFIER OUT OF RANGE?
@BOX 7.0
SET B PRECISION FROM EXPR
CODE.EXPR(IN B) : 11.3:
@BOX 10.0
PL B - 1
PL LIMIT
NOTE B NOT IN USE
@BOX 11.0
LOWER SPECIFIER ABSENT?
@BOX 12.0
REDUCE EXPR : 11.2:
@BOX 14.0
SPECIFIER NOT A CONSTANT?
@BOX 15.0
SPECIFIER SAME AS LOWER LIMIT?
@BOX 16.0
SPECIFIER OUT OF RANGE
@BOX 17.0
SET B PRECISION FROM EXPR
CODE.EXPR(IN B) : 11.3:
@BOX 20.0
PL B - 1
PL BASE
NOTE B OUT OF USE
@BOX 21.0
END
@BOX 23.0
FAULT
@BOX 25.0
FAULT
@BOX 30.0
STACK D IF NECESSARY
@BOX 31.0
STACK D IF NECESSARY
@BOX 28.0
RELOAD D IF NECESSARY
@BOX 29.0
RELOAD D IF NECESSARY
@BOX 1.1
@BOX 2.1
;LOC OF PROPS.T[AS[AP+2]]=>L.P=>F.L.PROP.G
;L.LEN OF L.P^=>L
;-1=>CU
;AS[AP+4] => SAP
;IF N0 & %400 /=0 THEN
   ;AS[AP+5]=>SAP
;FI
;IF AS[SAP+1]=>AP1=0
@BOX 3.1
;REDUCE.EXPR(AP1) => T
@BOX 4.1
;IF AS[AP1] & %1F => SK /= %10 /= %11
@BOX 5.1
;CONST OF PROPS.T[AS[AP1+2]]=>CP
;INT.CONST OF C.P^ => CU
;IF L>0 AND L=CU
@BOX 6.1
;IF CU<1 OR [L>0 AND CU>L]
@BOX 7.1
;CODE.EXPR(AP1,%102)
@BOX 10.1
;TL.PL(%9,TL.ONE.G)
;TL.PL(%67,0)
;-1 => B.AP.G
@BOX 11.1
;IF AS[SAP] => AP1 = 0
@BOX 12.1
;REDUCE.EXPR(AP1) => T
@BOX 14.1
;IF AS[AP1] & %1F => SK /= %10 /= %11
@BOX 15.1
;CONST OF PROPS.T[AS[AP1+2]] => C.P
;IF INT.CONST OF C.P^ => CL = 1
@BOX 16.1
;IF CL < 1 OR[CU>0 AND CL>CU]
   OR [L>0 AND CL>L]
@BOX 17.1
;CODE.EXPR(AP1,%102)
@BOX 20.1
;TL.PL(9,TL.ONE.G)
;TL.PL(%66,1)
;-1 => B.AP.G
@BOX 21.1
@BOX 23.1
;FAULT(102,1)
@BOX 25.1
;FAULT(102,1)
@BOX 30.1
;IF T & %A40 => T /= 0 THEN
   ;TL.PL(%47,%1005)
;FI
@BOX 31.1
;IF T & %A40 => T /= 0 THEN
   ;TL.PL(%47,%1005)
;FI
@BOX 28.1
;IF T & %A40 /= 0 THEN
   ;TL.PL(%62,%1005)
;FI
@BOX 29.1
;IF T & %A40 /= 0 THEN
   ;TL.PL(%62,%1005)
;FI
@END
@TITLE FTN11.13(1,10)
@COL 1S-2R-14T-3T-4T-5R-6T-7T-8R-9F
@COL 12T-13T-10R-11C
@ROW 4-12
@ROW 7-13
@FLOW 1-2-14N-3N-4N-5-6N-7N-8-9
@FLOW 14Y-7
@FLOW 3Y-12N-5
@FLOW 4Y-10-11
@FLOW 6Y-13N-8
@FLOW 7-10
@FLOW 12Y-10
@FLOW 13Y-10
@BOX 1.0
CALC.CHAR.EXPR.LENGTH(EXPR)LENGTH
@BOX 2.0
SET LENGTH = 0
@BOX 3.0
LH NODE NOT A
TERMINAL NODE?
@BOX 4.0
LENGTH OF STRING NOT
STATICALLY KNOWN?
@BOX 5.0
ADD ITS SIZE TO LENGTH
@BOX 6.0
RH NODE NOT A
TERMINAL NODE?
@BOX 7.0
LENGTH OF STRING NOT
STATICALLY KNOWN?
@BOX 8.0
ADD ITS SIZE TO LENGTH
@BOX 9.0
END-LENGTH
@BOX 10.0
FAULT
@BOX 11.0
END-1
@BOX 12.0
CALL CHAR EXPR LENGTH(LH.NODE):11.13:
ADD ITS SIZE TO LENGTH
FAULTY?
@BOX 13.0
CALC CHAR EXPR LENGTH(RH NODE):11.13:
ADD ITS SIZE TO LENGTH
FAULTY?
@BOX 14.0
TERMINAL NODE?
@BOX 1.1
;PROC CALC.CHAR.EXPR.LENGTH(AP)
;$IN L,NAP,T
@BOX 2.1
;0 => L
@BOX 3.1
;IF AS[AS[AP+1] => NAP] & %10 = 0
@BOX 4.1
;IF STR.SIZE(NAP) => T<0
@BOX 5.1
;T +> L
@BOX 6.1
;IF AS[AS[AP+2] => NAP] & %10 = 0
@BOX 7.1
;IF STR.SIZE(NAP) => T<0
@BOX 8.1
;T +> L
@BOX 9.1
;L => CALC.CHAR.EXPR.LENGTH
;END
@BOX 10.1
;FAULT(103,1)
@BOX 11.1
;-1 => CALC.CHAR.EXPR.LENGTH
;EXIT
@BOX 12.1
;IF CALC.CHAR.EXPR.LENGTH(NAP) => T < 0
@BOX 13.1
;IF CALC.CHAR.EXPR.LENGTH(NAP) => T<0
@BOX 14.1
;IF AS[AP=>NAP] & %10 /= 0
@END
@TITLE FTN11.14(1,11)
@COL 1S-2T-3T-4R-5R-6R-7F
@FLOW 1-2N-3N-4-5-6-7
@FLOW 3Y-5
@FLOW 2Y-7
@BOX 1.0
CHECK.CONST(AP,CONST.TYPE,OTHER.OP.TYPE)
@BOX 2.0
IS CONSTANT OF >= PRECISION
THAN OTHER OP TYPE?
@BOX 3.0
NOT A NAME CONSTANT?
@BOX 4.0
COPY CONSTANT INTO LINE SPACE : 11.8:
UPDATE NODE INFO
@BOX 5.0
CHANGE CONSTANT TYPE : 11.1:
@BOX 6.0
UPDATE NODE.INFO
@BOX 7.0
END
@BOX 1.1
;PROC CHECK.CONST(AP,CT,OT)
;$IN I
;ADDR CONST.PROP CP
@BOX 2.1
;IF RANK[CT=>CHECK.CONST*5+OT]/=1
@BOX 3.1
;AS[AP+2] => I
;IF AS[AP] & %F = 0
@BOX 4.1
;COPY.CONST(CONST OF PROPS.T[I] => CP,0)=>CONST OF PROPS.T[I]
@BOX 5.1
;CHANGE.CONST.TYPE(CONST OF PROPS.T[I],CT,OT=>CHECK.CONST)
@BOX 6.1
;AS[AP] & %8F1F ! (OT<<-12) ! ( CONST.PRECISION(CP, OT) <<- 5) => AS[AP]
@BOX 7.1
;END
@END
@TITLE FTN11.15(1,11)
@COL 1S-2T-5R-6R-7R-8R-9F
@FLOW 1-2N-5-6-7-8-9
@FLOW 2Y-9
@BOX 1.0
LOAD.A.FROM.T
@BOX 2.0
T NOT IN USE
@BOX 5.0
SET A TYPE TO LOGICAL
:11.6:
@BOX 6.0
PLANT A= REQUIRED FN OF T
@BOX 7.0
UPDATE NODE
@BOX 8.0
SET T AS NOT IN USE
@BOX 9.0
END
@BOX 1.1
;PROC LOAD.A.FROM.T
@BOX 2.1
;IF T.AP.G < 0
@BOX 5.1
;SET.A.TYPE(4,0)
@BOX 6.1
;TL.PL(%22,TL.REL.T.FN[AS[T.AP.G] ->> 5 & %7])
@BOX 7.1
;2->AS[T.AP.G => A.AP.G]
@BOX 8.1
;-1 => T.AP.G
@BOX 9.1
;END
@END
@TITLE FTN11.16(1,10)
@COL 14R
@COL 1S-2T-3R-4R-5R-6F
@ROW 14-3
@FLOW 1-2N-3-4-5-6
@FLOW 2Y-14-6
@BOX 1.0
TYPE NODE(AP)
@BOX 2.0
A TERMINAL NODE?
@BOX 3.0
TYPE LH NODE : 11.16
@BOX 4.0
TYPE RH NODE : 11.16
@BOX 5.0
CHECK TYPE COMPATIBILITY
[11.16.2]
@BOX 6.0
END
@BOX 14.0
TYPE TERMINAL NODE : 11.16.1:
@BOX 1.1
;PROC TYPE.NODE(AP)
;PSPEC TYPE.TERMINAL.NODE($IN)
;PSPEC CHECK.NODES($IN)
#FTN11.16.1
#FTN11.16.2
@BOX 2.1
;IF AS[AP] & %10 /= 0
@BOX 3.1
;TYPE.NODE(AS[AP+1])
@BOX 4.1
;TYPE.NODE(AS[AP+2])
@BOX 5.1
;CHECK.NODES(AP)
@BOX 6.1
;END
@BOX 14.1
;TYPE.TERMINAL.NODE(AP)
@END
@TITLE FTN11.16.1(1,10)
@COL 3C-4R-5C-6C-7R-8T-9T-10C-14C-15C
@COL 1S-2R-16C-38T-39T-17R-18T-19T-20R-21C
@COL 35C-36R-11T-12R-37F-40C-41R-42T-43T-44C-29R-30C
@FLOW 1-2
@FLOW 16-38N-39N-17-18N-19N-20-21
@FLOW 39Y-40
@FLOW 3-4-5
@FLOW 6-7-8N-9N-10
@FLOW 18Y-41-42N-43Y-42Y-29-30
@FLOW 43N-44
@FLOW 19Y-14
@FLOW 8Y-15
@FLOW 9Y-14
@FLOW 35-36-11N-12-37
@FLOW 38Y-17
@FLOW 11Y-37
@BOX 1.0
TYPE TERMINAL NODE (AP)
@BOX 2.0
PROCESS ACCORDING TO KIND
CONST, CONST.NAME, ARRAY : 11.16.1:
VARIABLE, FN : 11.16.1.1:
UNDEF : 11.16.1.2:
LABEL, SUBSTRING, FAULTS :11.16.1.7:
@BOX 16.0
ARRAY
@BOX 38.0
ARRAY DECLARED?
@BOX 39.0
DECLARE ARRAY:6.5:
INVALID?
@BOX 40.0
REDUCE.EXPR
FAULT:11.2:
@BOX 17.0
SET TYPE
SET MUTLNAME
@BOX 18.0
SUBSCRIPTS PRESENT?
@BOX 19.0
SUBSTRING PRESENT
@BOX 20.0
SET NODE, KIND, PRECISION
SET EXPR KIND
@BOX 21.0
RET
@BOX 3.0
CONSTANT
@BOX 4.0
UPDATE EXPR KIND
SET CONSTANT PRECISION
@BOX 5.0
END
@BOX 6.0
CONST
NAME
@BOX 7.0
SET NODE TYPE, KIND, AND PRECISION
SET EXPR KIND
MAKE NODE INTO A CONSTANT
@BOX 8.0
SUBSCRIPTS PRESENT?
@BOX 9.0
SUBSTRING PRESENT?
@BOX 10.0
RET
@BOX 14.0
SUBSTRING
FAULT
@BOX 15.0
SUBSCRIPT
FAULT
@BOX 28.0
REDUCE.EXPR
FAULT:11.2:
@BOX 29.0
SET NODE KIND
 AND PRECISION
SET EXPR KIND
@BOX 30.0
CHECK
SUBSTRING
@BOX 31.0
FAULT
@BOX 33.0
FAULT
@BOX 35.0
RET
@BOX 36.0
UPDATE NODE
UPDATE.EXPR.KIND
@BOX 37.0
END
@BOX 41.0
GET FIRST SUBSCRIPT
@BOX 42.0
ALL SUBSCRIPT EXPR
REDUCED
@BOX 43.0
REDUCE NEXT SUBSCRIPT EXPR
@BOX 44.0
SUBSCRIPT FAULT
@BOX 11.0
NOT PROC CALL
@BOX 12.0
CHECK ARGS OF CALL [11.16.1.8]
@BOX 1.1
;PROC TYPE.TERMINAL.NODE(AP)
;LITERAL/ADDR[$LO8] NILSTR=
;$IN K,TMP,TT,T,EK,N0,V,LK,LT,TL.NAME,PR,PROC.F,L
;ADDR LOCAL.PROP LP,ARG.LP, I.LP :: ??? JM 25-JAN-83
;$IN I,ARG.NAME,IT,I.AP,A.AP, ARG.PR
;ADDR CONST.PROP CPL,CPR,CP
;ADDR [$LO8] CHPL,CHPR,CHP
;$LO16 N
;$IN D.BIT,LS,R,AL.AP,P,J,ET,Z
;$IN AP1,ARG.CNT,SPEC.P,F,RT,INTR
;ADDR GLOBAL.PROP GP
;ADDR[$LO8] A.E
;AS[AP+2] => V
;PSPEC CH.ARG.LIST($IN)
#FTN11.16.1.8
;P.SPEC FILL.ARG.SPEC(ADDR[$LO8],$IN,$IN,
      ADDR LOCAL.PROP,$IN,$IN,$IN)
#FTN11.16.1.4
@BOX 2.1
;0 => D.BIT => PR => PROC.F
;IF AS[AP] => N0 & %F => K = 0,
       -> FTN11.16.1.B3
;IF K=10, -> FTN11.16.1.7B11
;LOC OF PROPS.T[V] => LP
;L.TL.NAME OF LP^ => TL.NAME
;L.TYPE OF LP^ =>LT=> T
;L.SPECS OF LP^ => LS & %200 => D.BIT
;IF L.KIND OF LP^ => LK>3,
      -> FTN11.16.1.1B2
;SWITCH LK \
FTN11.16.1.2.B12,
FTN11.16.1.1.B12,
FTN11.16.1.B16,
FTN11.16.1.B6
#FTN11.16.1.1
#FTN11.16.1.2
#FTN11.16.1.7
@BOX 16.1
;FTN11.16.1B16:
@BOX 38.1
;IF TL.NAME /= 0
@BOX 39.1
;IF CHECK.IMPLICIT.DECL(LP) /= 0
@BOX 17.1
;L.TL.NAME OF LP^ =>TL.NAME
@BOX 40.1
;->REDUCE.EXPR.FAULT
@BOX 18.1
;IF N0 & %400 /=0
@BOX 19.1
;IF N0 & %800 /=0
@BOX 20.1
;L.LEN OF LP^ => PR
;8 => K
;%400 => EK
@BOX 21.1
; -> FTN11.16.1B35
@BOX 3.1
;FTN11.16.1B3:
@BOX 4.1
;%10 !> EXPR.TYPE
;IF N0 ->> 12 => T <  5 THEN
    CONST.PRECISION(CONST OF PROPS.T[AS[AP+2]],T)
               <<- 5 ! (AS[AP] & %FF1F) => AS[AP]
 FI
@BOX 5.1
;EXIT
@BOX 6.1
;FTN11.16.1.B6:
@BOX 7.1
;%20 => EK
;0 => K
;1 +> PROPS.I => AS[AP + 2]
;L.CONST.P OF L.ALT OF L.P^ => CP
;IF LT /= 5 THEN
   ;L.LEN OF LP^ => PR
   ;CP => CONST OF PROPS.T[PROPS.I]
;ELSE
   ;BYTE(CH.CONST OF C.P^) =>
         ADDRESS OF PROPS.T[PROPS.I]
;FI
@BOX 8.1
;IF N0 & %400 /= 0
@BOX 9.1
;IF N0 & %800 /= 0
@BOX 10.1
;-> FTN11.16.1B35
@BOX 14.1
; -> FTN11.16.1.7B32
@BOX 15.1
;-> FTN11.16.1.7B26
@BOX 35.1
;FTN11.16.1B35:
@BOX 36.1
;EK !> EXPR.TYPE
;IF T = 5 THEN 0 => PR FI
;N0 & %0E00 ! %10 ! (PR<<-5) ! K
 ! D.BIT ! (T<<-12) => AS[AP]
;TL.NAME=>AS[AP+1]
@BOX 37.1
;END
@BOX 29.1
;L.LEN OF LP^ => PR
;%200 => E.K
;%403 => K
@BOX 30.1
;->FTN11.16.1.7B22
@BOX 41.1
;AS[AS[AP + 4] => AP1] +1 => I
@BOX 42.1
;IF 1 -> I =< 0
@BOX 43.1
;IF REDUCE.EXPR(AS[AP1 + I]) & %E40F = 3
@BOX 44.1
;->FTN11.16.1.7B26
@BOX 11.1
;IF PROC.F = 0
@BOX 12.1
;CH.ARG.LIST(AP)
@END
@TITLE FTN11.16.1.1(1,11)
@COL 33R-20R-18F-12C-13R-14T-15R-16C-23T-17C
@COL 1S-2C-32T-27N-3T-34T-35R-36T-37T-38C-31T-28T-25T-22R-4T-5T-6T-24R-7R-8C-9R-
10C
@COL 11C-26C-21T-19T
@ROW 33-27
@ROW 22-26
@ROW 6-21
@ROW 20-34-11
@ROW 5-18
@FLOW 2-32N-3N-34N-35-36N-37Y-36Y-31N-28N-25N-22-4N-5N-6N-24-7-8
@FLOW 25Y-26
@FLOW 28Y-22
@FLOW 34Y-31
@FLOW 37N-38
@FLOW 3Y-11
@FLOW 4Y-18
@FLOW 5Y-21N-19N-7
@FLOW 21Y-7
@FLOW 19Y-9
@FLOW 6Y-9-10
@FLOW 12-13-14N-15-16
@FLOW 14Y-23N-17
@FLOW 23Y-20-35
@FLOW 31Y-4
@FLOW 32Y-33-3
@BOX 1.0
TYPE TERMINAL NODE/CONT
@BOX 2.0
PROC
@BOX 3.0
SUBSTRING PRESENT?
@BOX 31.0
NOT AN EXTERNAL FN OR SUBR
@BOX 4.0
ARG LIST PRESENT?
@BOX 5.0
EXTERNAL FN OR SUBR?
@BOX 6.0
STATEMENT FUNCTION OR
GENERIC OR INVALID
INTRINSIC?
@BOX 7.0
SET NODE TYPE, KIND
SET MUTLNAME
SET EXPR KIND
@BOX 8.0
RET
:11.16.1:
@BOX 9.0
FAULT
@BOX 10.0
REDUCE
EXPR FAULT
:11.2:
@BOX 11.0
SUBSTRING
FAULT
:11.16.1:
@BOX 12.0
VARIABLE
@BOX 13.0
SET MUTLNAME
SET TYPE
@BOX 14.0
SUBSCRIPTS PRESENT?
@BOX 15.0
SET NOTE KIND
SET EXPR KIND
SET NODE PRECISION
@BOX 16.0
CHECK
SUBSTRING
: 11.16.1:
@BOX 17.0
SUBSCRIPT
FAULT
:11.16.1:
@BOX 18.0
PROCESS
ARG LIST
:11.16.1.6:
@BOX 19.0
NON FORTRAN PROC
@BOX 20.0
FAULT
@BOX 21.0
DUMMY ARGUMENT?
@BOX 22.0
PROCESS PROC SPEC
:11.16.1.3:
@BOX 23.0
RECURSIVE FUNCTION CALL
@BOX 24.0
DEFINE A FORTRAN PROCEDURE
TO CALL SPECIFIC INTR SO ITS NAME MAY BE
PASSED AS AN ACTUAL ARGUMENT :11.16.1.5:
@BOX 32.0
EXTERNAL WITH KIND STILL UNDEFINED AND
ARGUMENT LIST PRESENT
@BOX 28.0
DUMMY ARG?
@BOX 33.0
SET KIND TO FN
@BOX 34.0
NO ARG LIST?
@BOX 35.0
GET FIRST ARGUMENT
@BOX 36.0
ALL EXPRS REDUCED?
@BOX 37.0
REDUCE NEXT ARGUMENT EXPR
OK?
@BOX 38.0
REDUCE EXPR
FAULT:11.2:
@BOX 25.0
RECURSIVE CALL?
@BOX 26.0
PROCESS RECURSION
:FTN11.16.1.9:
@BOX 1.1
@BOX 2.1
;FTN11.16.1.1B2:
@BOX 32.1
;IF LK = 8 AND N0 & %400 /= 0
@BOX 33.1
;6 => L.KIND OF LP^ => LK
@BOX 3.1
;IF N0 & %800 /= 0
@BOX 31.1
;IF LK = 7 OR  LK = 4
@BOX 19.1
;ADD.G.NAME(^L.NAME OF LP^)=>GP
;IF G.KIND OF G.P^ & 7 => TMP = 5
    OR TMP = 6
@BOX 20.1
;LP => F.L.PROP.G
;FAULT(128,1)
@BOX 21.1
;IF D.BIT /= 0
@BOX 22.1
#FTN11.16.1.3
@BOX 4.1
;IF N0 & %400 /=0
@BOX 5.1
;IF LK /= 7 /= 4
@BOX 6.1
;IF LK = 4 OR
GEN.INTR[L.INTR.NO OF LALT OF LP^=>INTR] & %80 = 0
@BOX 7.1
; %1000 => EK
;9=>K
@BOX 8.1
; ->
FTN11.16.1B35
@BOX 9.1
;LP=>F.L.PROP.G
;FAULT(104,1)
@BOX 10.1
;->
REDUCE.EXPR.FAULT
@BOX 11.1
;->
FTN11.16.1.7B32
@BOX 12.1
;FTN11.16.1.1B12:
@BOX 13.1
;L.TL.NAME OF LP^ => TL.NAME
;L.TYPE OF LP^ => T
@BOX 14.1
;IF N0 & %400 /= 0
@BOX 15.1
;2 => K
;IF D.BIT /=0 THEN
;%40 => EK
;ELSE IF LS & %10 /=0 THEN
;%80 => EK
;ELSE
;%100 => EK
;FI ;FI
;L.LEN OF LP^ => PR
@BOX 16.1
;->
FTN11.16.1.7B22
@BOX 17.1
;->
FTN11.16.1.7B26
@BOX 18.1
#FTN11.16.1.6
@BOX 23.1
;IF L.SPECS OF LP^ & %800 /= 0
@BOX 24.1
#FTN11.16.1.5
@BOX 34.1
;IF N0 & %400 = 0
@BOX 35.1
;AS[AS[AP+4]=>AP1] + 1 => I
@BOX 36.1
;IF 1 -> I =< 0
@BOX 37.1
;IF REDUCE.EXPR(AS[AP1 + I]) /= -1
@BOX 38.1
;->REDUCE.EXPR.FAULT
@BOX 25.1
;ADD.G.NAME(^L.NAME OF LP^) => GP
;G.KIND OF GP^ & 7 => I
;IF L.SPECS OF LP^ & %800 /= 0
@BOX 26.1
#FTN11.16.1.9
@BOX 28.1
;L.KIND OF LP^ => F
;IF D.BIT /= 0
@END
@TITLE FTN11.16.1.2(1,6)
@COL 1S-12C-2T-5T-20R-6C-14T-7T-8R-9C
@COL 21C-15R-10R
@ROW 6-21
@ROW 7-15
@FLOW 12-2N-5N-20-6
@FLOW 5Y-21
@FLOW 2Y-14N-7N-8-9
@FLOW 7Y-10-9
@FLOW 14Y-15-8
@BOX 1.0
TYPE TERMINAL NODE/CONT
@BOX 12.0
UNDEFINED
@BOX 2.0
AN ARGUMENT LIST
PRESENT?
@BOX 5.0
DECLARE IMPLICIT VARIABLE
STATICALLY IF SAVED:6.5:
INVALID?
@BOX 20.0
SAVE MUTL NAME
@BOX 21.0
REDUCE.EXPR
FAULT
:11.2:
@BOX 6.0
VARIABLE
: 11.16.1.1:
@BOX 7.0
IS IT AN INTRINSIC
FUNCTION?
@BOX 8.0
SET PROPS AS AN
EXTERNAL FUNCTION
RESET ARG SPEC PTR
@BOX 9.0
PROC
: 11.16.1.1:
@BOX 10.0
UPDATE PROPS FOR
INTRINSIC FUNCTION
@BOX 14.0
DUMMY VARIABLE?
@BOX 15.0
INFORM MUTL OF DUMMY
ARGUMENT TYPE
@BOX 12.1
;FTN11.16.1.2B12:
@BOX 2.1
;IF N0 & %400 /= 0
@BOX 5.1
;1 => LK
;IF CHECK.IMPLICIT.DECL(LP) /= 0
@BOX 20.1
;L.TL.NAME OF LP^=>TL.NAME
@BOX 21.1
;->REDUCE.EXPR.FAULT
@BOX 6.1
;-> FTN11.16.1.1B12
@BOX 7.1
;IF LOOK.UP.INTRINSIC(LP) => I > = 0
@BOX 8.1
;NIL.STR => L.ARG.SPEC.P OF LALT OF LP^
;6 => LK => L.KIND OF LP^
;0=>L.SPEC.TL.NAME OF LALT OF LP^
@BOX 9.1
;-> FTN11.16.1.1B2
@BOX 10.1
;7 => LK => L.KIND OF LP^
;I => L.INTR.NO OF LALT OF LP^
@BOX 14.1
;IF D.BIT /= 0
@BOX 15.1
;TL.SET.TYPE(TL.NAME,%24)
@END
@TITLE FTN11.16.1.3(1,11)
@COL 31R-17C-26T-32T-27R-14R-15R-33C-21R
@COL 1S-5T-23T-30T-24R-29T-25T-2R-3T-4R-6R-7R-8R-9T-10R-12R-13F
@ROW 31-24
@ROW 10-21
@FLOW 1-5N-23N-30N-24-29N-25N-2-3N-4-6-7-8-9N-10-12-13
@FLOW 30Y-31-17
@FLOW 3Y-14-15-7
@FLOW 9Y-21-12
@FLOW 5Y-12
@FLOW 29Y-12
@FLOW 23Y-25Y-26N-32N-27-12
@FLOW 26Y-12
@FLOW 32Y-33
@BOX 1.0
PROCESS PROC SPECS
@BOX 23.0
DUMMY ARGUMENT?
@BOX 30.0
LOCAL AND GLOBAL
KIND DIFFERENT?
@BOX 24.0
UPDATE GLOBAL KIND IF NECESSARY
COPY ARG SPEC PTR AND TL.NAME
TO LOCAL PROPS
@BOX 31.0
FAULT
@BOX 25.0
NO ARGUMENT LIST PRESENT?
@BOX 26.0
TL NAME ALLOCATED?
@BOX 27.0
UPDATE LOCAL AND GLOBAL PROPS
WITH MUTL NAME OF PROC.SPEC
@BOX 29.0
ARGUMENT SPEC DEFINED GLOBALLY?
@BOX 2.0
GET N0 OF ARGUMENT
@BOX 3.0
FN A DUMMY ARGUMENT?
@BOX 4.0
SET PROC SPEC KIND
IE EITHER
NEW PROC WITH PARAM SPEC OR
OLD PROC WITH PARAM SPEC
@BOX 5.0
ARG SPECIFICATION PREVIOUSLY DEFINED?
@BOX 6.0
MAKE ARG SPECIFICATION IN MODULE SPACE
@BOX 7.0
COMPLETE ARG SPECIFICATION ENTRY
BY EVAL EXPR KIND OF ALL ACTUAL ARGUMENTS
:11.16.1.4:
@BOX 8.0
DECLARE TL.PROC.SPEC:6.4:
SAVE ARG SPEC IN LOCAL PROP
@BOX 9.0
DUMMY VARIABLE
@BOX 10.0
SAVE TL.NAME
@BOX 12.0
RETURN TL NAME
@BOX 13.0
END
@BOX 14.0
MAKE ARG ENTRY IN
LOCAL SPACE
@BOX 15.0
SET PROC.SPEC.KIND TO
PROC VARIABLE
@BOX 17.0
REDUCE EXPR
FAULT:11.2:
@BOX 21.0
SAVE TL.NAME
@BOX 32.0
NO MORE PRE-DECLARED
EMPTY PROCS?
@BOX 33.0
ABORT COMPILE
@BOX 1.1
@BOX 2.1
;AS[AS[AP+4]=>AP1]=>ARG.CNT
@BOX 3.1
;IF D.BIT /=0
@BOX 4.1
;IF L.TL.NAME OF LP^ => SPEC.P = 0 THEN
    ;%8001 => SPEC.P :: ??? JM 1-FEB-83
;ELSE
    ;%1000 !> SPEC.P
;FI
@BOX 5.1
;IF L.ARG.SPEC.P OF LALT OF LP^ /= NIL.STR
@BOX 6.1
;MAKE.LO8(ARG.CNT*2+3,GLOBAL.SPACE)=>A.E
@BOX 7.1
;FILL.ARG.SPEC(AE,LK,LT,LP,ARG.CNT,AP1,D.BIT) :: @@@ BCT 3-FEB-83 Sorry
@BOX 8.1
;DECLARE.PROC.SPEC(A.E,SPECP,NAME OF LNAME OF LP^) => N :: ??? JM 27-DEC-82
;AE => L.ARG.SPEC.P OF LALT OF LP^
@BOX 9.1
;IF D.BIT /= 0
@BOX 21.1
;N => L.SPEC.TL.NAME OF LALT OF LP^
@BOX 10.1
;N => L.TL.NAME OF LP^
;N => G.TL.NAME OF GP^
;AE => G.ARG.SPEC.P OF GP^
@BOX 12.1
;L.TL.NAME OF LP^ => TL.NAME
@BOX 13.1
::END
@BOX 14.1
;MAKE.LO8(ARG.CNT*2+3,LOCAL.SPACE)=>A.E
=> L.ARG.SPEC.P OF LALT OF LP^
@BOX 15.1
;%10 => SPEC.P
@BOX 17.1
;->REDUCE.EXPR.FAULT
@BOX 30.1
;IF [ I /=0 /=4 < 6 OR F /= 5 /= 8] AND
    [I /= 0 /=3 /= 5 /= 7 OR F < 6]
@BOX 24.1
;IF I=0 OR I=7 THEN
   IF F=6 THEN 3=>I
    ELSE F-1=>I FI
   ;G.KIND OF G.P^ & 8 ! I =>
     G.KIND OF G.P^
FI
;G.TL.NAME OF GP^ => L.TL.NAME OF LP^
@BOX 31.1
; LP => F.L.PROP.G
; FAULT(127,1)
@BOX 23.1
IF D.BIT /=0
@BOX 25.1
;IF N0 & %400 = 0
@BOX 26.1
;IF L.TL.NAME OF LP^ /= 0
@BOX 27.1
 :: ??? JM 1-FEB-83
;TL.PROC.SPEC (NAME OF L.NAME OF LP^, PSPEC.N.G ! %B000)
;PSPEC.NG => G.TL.NAME OF GP^ => L.TL.NAME OF LP^
    +1 => PSPEC.N.G
@BOX 29.1
;IF G.ARGSPEC.P OF GP^ =>
      L.ARG.SPEC.P OF L.ALT OF LP^ /= NIL.STR
@BOX 32.1
; IF 1 -> PSPEC.CNT < 0
@BOX 33.1
;FAULT(130,6)
; -> ABORT.COMPILE
@END
@TITLE FTN11.16.1.4(1,11)
@COL 1S-7R-28T-2F
@COL 16R-17C
@ROW 16-2
@FLOW 1-7-28N-2
@FLOW 28Y-16-17
@BOX 1.0
FILL ARG SPEC
@BOX 2.0
END
@BOX 17.0
REDUCE EXPR
FAULT:11.2:
@BOX 16.0
FAULT
@BOX 28.0
ANY LABEL ARGS WITH A FN?
@BOX 7.0
COMPLETE ARG SPECIFICATION ENTRY
@BOX 1.1
;PROC FILL.ARG.SPEC(AE,LK,LT,LP,ARG.CNT,AP1,D.BIT)
;$IN L,R,F,I,TT,ET,P
@BOX 2.1
; END
@BOX 7.1
;0 => L
;IF LK=6 THEN
   ;LT=>R
;IF LT /= 5 THEN
    L.LEN OF LP^ => L FI
;ELSE
   ;7=>R
   ;1=>L
;FI
;R=>A.E^[0=>P]
;L=>AE^[1]
;0=>F; 0=>I
;WHILE 1+>I =< ARG.CNT DO
   ;AS[AS[I + AP1]] => ET ->> 12 & %7 => R
   ;IF E.T & %1F /= %19 /= %1A THEN
      ;%68!>R
      ;IF ET& %1F = %F THEN
          %10 => L
       ELSE ET ->> 5 & 7 => L
           ;IF ET & %1F => TT = %10 OR TT = %11 OR TT & %10 = 0 THEN
               IF D.BIT = 0 THEN %10 !> L
               ELSE VAL.ARG.Z.G => L FI
            FI
       FI
   ;ELSE IF E.T & %1F = %1A THEN ::LABEL
      ;%6=>R
      ;0 => L
      ;IF L.K /=5 THEN
         ;1=>F
      ;FI
   ;ELSE
      ;%10!>R
      ;0=>L
   ;FI FI
   ;R=>A.E^[2+>P]
   ;L => AE^[P+1]
;OD
;%FF=>A.E^[2+>P]
@BOX 16.1
;FAULT(105,1)
@BOX 17.1
;->REDUCE.EXPR.FAULT
@BOX 28.1
;IF F /= 0
@END
@TITLE FTN11.16.1.5(1,11)
@COL 1S-2T-3R-4R-5R-6R-7R-8R-9F
@FLOW 1-2N-3-4-5-6-7-8-9
@FLOW 2Y-9
@BOX 1.0
CREATE PARAMETRIC VERSION OF
INTRINSIC
@BOX 2.0
INTRINSIC PREVIOUSLY PASSED
PARAMETRICALLY?
@BOX 3.0
CREATE PROC SPEC
@BOX 4.0
START PROC BODY
UPDATE PROPS
@BOX 5.0
CREATE TERMINAL NODE FOR
INTR FEFN CALL
@BOX 6.0
CREATE INTR REFN ARGUMENT LIST
WITH DUMMY ARGS AS ACTUAL ARGS
@BOX 7.0
CODE INTR REFN CALL
@BOX 8.0
PLANT RETURN
END PROC BODY
@BOX 9.0
END
@BOX 1.1
@BOX 2.1
;IF L.SPEC.TL.NAME OF L.ALT OF LP^ => TL.NAME /= 0
@BOX 3.1
;TL.PROC.SPEC(NIL.STR,1)
;INTR * 7 => I; 0 => N
                      :: ??? JM 24-JAN-83
;WHILE INTR.ARG.SPECS[INTR.ARG.STRIDE +> N + I] /= %FF DO
   ;TL.PROC.PARAM(D.ARG.TYPE.L,0)
;OD
;TL.PROC.RESULT(MUTL.TYPE( INTR.ARG.SPECS[I] => I.T=>T, L.LEN OF LP^))
@BOX 4.1
;TL.PROC(MUTL.NG => TL.NAME => L.SPEC.TL.NAME OF L.ALT OF LP^)
;1+> MUTL.NG => ARG.NAME
@BOX 5.1
;I.T <<- 12 ! %417 ! (L.LEN OF L.P^ & 7 <<-5) => AS[END.AP.G => I.AP]
;INTR => AS[I.AP+1]
;LOC OF PROPS.T[AS[AP+2] => AS[I.AP+2]] => I.LP :: ??? JM 25-JAN-83
;7 => L.KIND OF I.LP^ :: ??? JM 25-JAN-83
;AS[AP+3] => AS[I.AP+3] :: ??? JM 25-JAN-83
;I.AP+5 => AL.AP => AS[I.AP+4]
;N/INTR.ARG.STRIDE -1  => AS[AL.AP] + AL.AP + 1 => A.AP :: ??? JM 24-JAN-83
; 6 +> END.AP.G
@BOX 6.1
;WHILE INTR.ARG.SPECS[2 +> I] => TT /= %FF DO
;A.AP => AS[1 +> AL.AP]
;%601F=>AS[A.AP]
;ARG.NAME => AS[A.AP+1]
;MAKE.LOCAL.PROP(LINE.SPACE)=>ARG.LP
;1=>L.KIND OF ARG.LP^
;TT& 7 => L.TYPE OF ARG.LP^
;IF INTR.ARG.SPECS[1 + I] => ARG.PR = %20 THEN
   ;I.ACC.Z.G => ARG.PR
;FI
;ARG.PR => L.LEN OF ARG.LP^
;%200 => L.SPECS OF ARG.LP^
;ARG.NAME =>L.TL.NAME OF ARG.LP^
;ARG.LP=> LOC OF PROPS.T[1+>PROPS.I]
;PROPS.I=>AS[A.AP+2]
;TL.SET.TYPE(ARG.NAME,
             MUTL.TYPE(TT & 7, ARG.PR) ! 1) :: ??? JM 25-JAN-83
;5 +> A.AP
;1+>ARG.NAME
;OD
@BOX 7.1
:: ;I.AP => I ;WHILE I < A.AP DO OUTHEX(AS[I],0) ;SPACES(2) ;1+>I OD
;REDUCE.EXPR(I.AP)
;CODE.PROC.CALL(I.AP)
@BOX 8.1
;TL.PL(%43,%3000)
;TL.END.PROC()
@BOX 9.1
@END
@TITLE FTN11.16.1.6(1,11)
@COL 1S-18T-4T-5R-19T-2T-3R-20T-21R-34T-35T-36R-6R-25R-26C
@COL 29R-30C
@ROW 29-21
@FLOW 1-18N-4N-5-19N-2N-3-20N-21-25-26
@FLOW 18Y-34N-35N-36-6-25
@FLOW 19Y-21
@FLOW 4Y-29
@FLOW 2Y-20
@FLOW 20Y-29-30
@FLOW 34Y-6
@FLOW 35Y-6
@BOX 1.0
PROCESS ARG LIST
@BOX 4.0
ZERO ARGUMENTS?
@BOX 5.0
SCAN ARGUMENT LIST
FIND MAX ARGUMENT PRECISION
@BOX 6.0
SET PRECISION
@BOX 18.0
 NOT INTR?
@BOX 19.0
SPECIFIC INTRINSIC?
@BOX 2.0
NOT CMPLX WITH 2 ARGUMENTS?
@BOX 3.0
SELECT 2 ARG CMPLX
SWOP ARGUMENTS
@BOX 20.0
EVALUATE EXPR TYPE
OF FIRST ACTUAL ARG
INVALID TYPE FOR
GENERIC?
@BOX 21.0
SET SPECIFIC TYPE
ENCODE ARGUMENT PRECISION IF NECESSARY
@BOX 25.0
SET NODE TYPE, KIND
SET EXPR KIND
NOTE PROC CALL
@BOX 26.0
RET
@BOX 29.0
FAULT
@BOX 30.0
REDUCE.EXPR
FAULT :11.2:
@BOX 34.0
NOT CHAR FUNCTION?
@BOX 35.0
RESULT VARIABLE ALLOCATED?
@BOX 36.0
DECLARE CHAR FUNCTION
RESULT VARIABLE
@BOX 4.1
;IF AS[AS[AP+4]=>AP1]=>I=0
@BOX 5.1
;MIN.INTR.Z.G => ARG.PR
;WHILE I > 0 DO
   ;IF (IF AS[AS[AP1 + I]] => R & %1F /= %F /= %1E
           THEN R ->> 5 & 7
           ELSE L.ACC.Z.G) => R > ARG.PR
       THEN R => ARG.PR
    FI
   ;1 -> I
;OD
@BOX 6.1
;L.LEN OF LP^ => PR
@BOX 18.1
;IF LK /= 7
@BOX 19.1
;IF GEN.INTR[L.INTR.NO OF L.ALT OF LP^
      => TL.NAME] & %7F =>INTR = %7F
@BOX 2.1
;IF INTR /= 26 OR AS[AS[AP+4]=>AP1]/= 2
@BOX 3.1
;27=>INTR
;AS[AP1+2]=>T
;AS[AP1+1]=>AS[AP1+2]
;T=>AS[AP1+1]
@BOX 20.1
;IF AS[AS[AP1+1]] ->> 12 & 7 => T >= 4 OR
    SEL.SPEC.INTR[INTR*4 + T] => TL.NAME = %FF
@BOX 21.1
;INTR.ARG.SPECS[TL.NAME*7=>I] & %7 =>T
;IF INTR.ARG.SPECS[I+3] = %20 THEN
   ;ARG.PR <<- 12 !> TL.NAME
;ELSE
   IF MIN.INTR.Z.G => ARG.PR < I.ACC.Z.G THEN
      ;I.ACC.Z.G => ARG.PR
;FI FI
;IF INTR.ARG.SPECS[I+1] => PR = %20 THEN
   ;ARG.PR => PR
;FI
@BOX 34.1
;IF LK /= 6 OR LT /= 5
@BOX 35.1
;IF LS & %4000 /= 0
@BOX 36.1
;TL.S.DECL(NIL.STR,%80,L.LEN OF LP^)
;MUTL.NG=> L.CH.RES.NAME OF L.ALT OF LP^
;1+> MUTL.NG
;%4000 !> L.SPECS OF LP^
@BOX 25.1
;LK => K
;%800 => EK
;1 => PROC.F :: ??? JM 31-DEC-82
@BOX 26.1
;->FTN11.16.1B35
@BOX 29.1
;LP=>F.L.PROP.G
;FAULT(106,1)
@BOX 30.1
;->REDUCE.EXPR.FAULT
@END
@TITLE FTN11.16.1.7(1,11)
@COL 22C-23T-24T-45T-34R-25C-32C-27R-28C
@COL 11C-12R-13C-26C-20R
@ROW 26-32
@FLOW 11-12-13
@FLOW 22-23N-24N-45N-34-25
@FLOW 45Y-27
@FLOW 23Y-25
@FLOW 24Y-27-28
@FLOW 26-20-28
@FLOW 32-27
@BOX 20.0
FAULT
@BOX 22.0
CHECK SUBSTRING
@BOX 23.0
SUBSTRING NOT PRESENT?
@BOX 24.0
NOT CHAR TYPE?
@BOX 25.0
RET
@BOX 26.0
SUBSCRIPT FAULT
@BOX 27.0
FAULT
@BOX 28.0
NEXT STAT
@BOX 11.0
LABEL
@BOX 12.0
UPDATE EXPR KIND
@BOX 13.0
END
@BOX 32.0
SUBSTRING
@BOX 34.0
SET NODE KIND
EXPR.KIND
@BOX 45.0
REDUCE SUBSTRING SPECIFIER
EXPRESSIONS. ANY FAULTS
@BOX 20.1
;FAULT(143,0 - AS[AP+3])
;LP => F.L.PROP.G
;FAULT(96,1)
@BOX 22.1
;FTN11.16.1.7B22:
@BOX 23.1
;IF N0 & %800 =0
@BOX 24.1
;IF T /= 5
@BOX 34.1
;%4000 => E.K
;%800 !> K
@BOX 25.1
;-> FTN11.16.1B35
@BOX 26.1
;FTN11.16.1.7B26:
@BOX 27.1
;FAULT(115,0-AS[AP+3])
@BOX 28.1
;->REDUCE.EXPR.FAULT
@BOX 11.1
;FTN11.16.1.7B11:
@BOX 12.1
;%2000 !> EXPR.TYPE
@BOX 13.1
;EXIT
@BOX 32.1
;FTN11.16.1.7B32:
@BOX 45.1
;4 => I
;IF N0 & %400 /= 0 THEN 5 => I FI
;0 => F
;IF AS[AS[AP+I]=>I]=>AP1 /= 0 THEN
   ;IF REDUCE.EXPR(AP1) & %E40F /= 3 THEN 1 => F FI
;FI
;IF AS[I+1]=>AP1 /= 0 THEN
   ;IF REDUCE.EXPR(AP1) & %E40F /= 3 THEN 1 => F FI
;FI
;IF F /= 0
@END
@TITLE FTN11.16.1.8(1,11)
@COL 1S-2R-3R-4T-27R-30T-5T-6T-7R-8T-9T-10T-11T-12T-28T-13R-14R-15R
@COL 16T-17F-31T-32R-18R-19R-20R-21T-22T-23R-33R-29R-24T-25R-26R
@ROW 16-27
@FLOW 1-2-3-4N-27-30N-5N-6N-7-8N-9N-10N-11N-15
@FLOW 10Y-12N-28N-13-14-15-4
@FLOW 4Y-16N-17
@FLOW 5Y-8
@FLOW 6Y-8Y-19-20
@FLOW 28Y-29-20
@FLOW 9Y-21N-22N-23-14
@FLOW 22Y-33-20
@FLOW 21Y-15
@FLOW 11Y-33
@FLOW 12Y-24N-25-14
@FLOW 24Y-26-20
@FLOW 16Y-18-20
@FLOW 30Y-31N-32-20
@FLOW 31Y-15
@BOX 1.0
CHECK ARG LIST (AP)
@BOX 2.0
GET SPEC OF FUNCTION
@BOX 3.0
OBTAIN FIRST ARGUMENT
@BOX 4.0
NO MORE ACTUAL OF DUMMY ARGUMENTS
@BOX 27.0
GET FORMAL AND ACTUAL ARG INFO
@BOX 5.0
ACTUAL ARG NOT CONSTANT OR EXPR
@BOX 6.0
ACTUAL ARG NOT INT/LOGICAL
@BOX 7.0
NOTE ACTUAL ARG IS VALUE SIZED
@BOX 8.0
ILLEGAL FORMAL ARGUMENT
(i.e. MUSS LIB ARG NOT KNOWN TO FORTRAN)
@BOX 9.0
FORMAL ARG A HOLL
@BOX 10.0
ACTUAL ARG NOT A HOLL
@BOX 11.0
HOLL ARG NOT ALLOWED
@BOX 12.0
FORMAL ARG NOT YET KNOWN
@BOX 28.0
MIXING CHAR AND NON CHAR ARGS?
@BOX 13.0
DO TYPE, SIZE AND KIND CHECKS
[11.16.1.9]
@BOX 14.0
UPDATE PERMITTED ARG KIND
@BOX 15.0
GET NEXT ARG
@BOX 16.0
NO OF ARGS INCORRECT
@BOX 17.0
END
@BOX 18.0
SET FAULT
@BOX 19.0
SET FAULT
@BOX 20.0
REPORT FAULT
@BOX 21.0
ACTUAL ARG A HOLL
@BOX 22.0
INVALID ACTUAL ARG
@BOX 23.0
SAVE ARG TYPE
@BOX 24.0
INVALID ARG TYPE
@BOX 25.0
SAVE ARG TYPE
@BOX 26.0
SET FAULT
@BOX 29.0
SET FAULT
@BOX 30.0
FORMAL ARG A SUBROUTINE NAME?
@BOX 31.0
ACTUAL ARG A SUBROUTINE NAME?
@BOX 32.0
SET FAULT
@BOX 33.0
SET FAULT
@BOX 1.1
;PROC CH.ARG.LIST (AP)
;$IN ET, AT, EZ, AZ, FA, N, P, VAR.F, Z,
  T, ARG.AP, ARG.0, E.K, F, INTR,
  ERR.DETAILS, INTR.OFFSET,OFFSET,INTR.DETAILS
;ADDR [$LO8] ARG
;ADDR LOCAL.PROP LP
;$LO16 B
;LOC OF PROPS.T[AS[AP+2]] => LP => F.L.PROP.G
;DATAVEC ILL.ARG.MASK ($LO16)
%FBFF %FDFF %0700 %0300
%F6F7 %FFFF %0600 %FFFF
END
@BOX 2.1
;IF AS[AP] & %F = 7 THEN
       AS[AP+1] => INTR & %FFF * 7 => T
      ;PART (^INTR.ARG.SPECS, T, T+7) => ARG
      ; %1081 => INTR.DETAILS
      ; 69 => INTR.OFFSET
 ELSE
       L.ARG.SPEC.P OF L.ALT OF LP^ => ARG
      ; %81 => INTR.DETAILS
      ; 0 => INTR.OFFSET
 FI
@BOX 3.1
;0 => VAR.F
;2 => P
;AS[AS[AP+4] => ARG.AP] => N
@BOX 4.1
; P/2 => F.I.G
;IF ARG^[P] => FA=%FF OR N=0
@BOX 5.1
;IF E.K > %11
@BOX 6.1
;IF E.T /= 3 /= 4
@BOX 7.1
;%10 !> E.Z
@BOX 8.1
;IF F.A = %81
@BOX 9.1
;IF A.T = 7
@BOX 10.1
;IF E.T /= 7
@BOX 11.1
;IF [AT > 4 OR FA & %8 = 0
     OR FA & %70 =< %10] AND
    [FA /= %80]
@BOX 12.1
;IF FA = %80
@BOX 13.1
#FTN11.16.1.8.1
@BOX 14.1
;IF FA & %F0 = %60 THEN
    IF E.K /= %13 /= %18 THEN
       %BF &> ARG^[P]
    ELSE IF E.K = %18 THEN
       %DF &> ARG^[P]
FI FI FI
@BOX 15.1
;1 -> N
;IF ARG^[2+P] /= %FE THEN 2+>P ELSE 1=>VAR.F FI
@BOX 16.1
;IF VAR.F=0 AND [N /= 0 OR FA /= %FF]
@BOX 17.1
;END
@BOX 18.1
;97 => F
@BOX 19.1
; 177 => F
@BOX 20.1
;FAULT (F,%81)
;-> REDUCE.EXPR.FAULT
@BOX 21.1
IF ET = 7
@BOX 22.1
;IF ET > 4 OR
EK=%19 OR EK=%1A
@BOX 23.1
;%68 ! E.T => ARG^[P] => FA
;E.Z => ARG^[P+1]
@BOX 24.1
;IF E.K = %19 THEN
    %10 => T
 ELSE IF E.K = %1A THEN
      0 => T
      ELSE
      %68 => T
 FI FI
;IF T = 0
@BOX 25.1
;ET => AT ! T => ARG^[P] => FA
;EZ => AZ => ARG^[P+1]
@BOX 26.1
;176 => F
@BOX 27.1
;AS[AS[1+>ARG.AP]] => ARG.0 ->> 12 & 7 => ET
;IF ARG.0 & %1F => EK = %F THEN
    0 => E.Z
 ELSE
    ARG.0 ->> 5 & 7 => E.Z
 FI
;FA & 7 => AT
;IF ARG^[P+1] => A.Z = %20 THEN
   ;INTR ->> 12 & 7 => A.Z
;FI
@BOX 28.1
;IF [AT = 5 AND ET /= 5]
  OR [ET = 5 AND AT /= 5]
@BOX 29.1
; 98 => F
@BOX 30.1
;IF FA = %1F
@BOX 31.1
;IF EK = %19
@BOX 32.1
;181 => F
@BOX 33.1
;179 => F
@END
@TITLE FTN11.16.1.8.1(1,11)
@COL 1S-4T-6T-5R-7T-8T-9T-10R-11T-2R-12T-3R-13F
@COL 14T-15T-16R-17R-18R
@ROW 14-8
@FLOW 1-4N-6N-5-7N-8N-9N-10-12N-3-13
@FLOW 7Y-14N-15N-16-17-12
@FLOW 14Y-18-12
@FLOW 15Y-17
@FLOW 4Y-7
@FLOW 9Y-12
@FLOW 6Y-7
@FLOW 12Y-13
@FLOW 8Y-11N-2-12
@FLOW 11Y-12
@BOX 1.0
DO TYPE, SIZE AND KIND CHECKS
@BOX 2.0
FAULT
@BOX 3.0
FAULT
@BOX 4.0
FORMAL ARG A FUNCTION
@BOX 5.0
FAULT
@BOX 6.0
EXPR OF WRONG TYPE
@BOX 7.0
FORMAL ARG STILL VALUE SIZED
@BOX 8.0
ACTUAL ARG NOT VALUED SIZED
@BOX 9.0
ACTUAL SIZE =< FORMAL
@BOX 10.0
WARNING
@BOX 11.0
ACTUAL SIZE /= FORMAL SIZE
@BOX 12.0
EXPR OF WRONG KIND
@BOX 13.0
END
@BOX 14.0
ACTUAL ARG VALUE SIZED
@BOX 15.0
ACTUAL SIZE >= FORMAL VALUE SIZE
@BOX 16.0
WARNING
@BOX 17.0
SET FORMAL SIZE=ACTUAL
@BOX 18.0
SET FORMAL = MAX (FORMAL, ACTUAL)
@BOX 1.1
:: BEGIN
@BOX 2.1
;FAULT(111+OFFSET,ERR.DETAILS)
@BOX 3.1
;FAULT(110+OFFSET,ERR.DETAILS)
@BOX 4.1
;IF FA & 8 = 0 THEN
   %1000 ! INTR.DETAILS => ERR.DETAILS
  ;69 ! INTR.OFFSET => OFFSET
 ELSE
   INTR.DETAILS => ERR.DETAILS
  ;INTR.OFFSET => OFFSET
 FI
;IF FA & %FD = %10
@BOX 5.1
;FAULT(109+OFFSET,ERR.DETAILS)
@BOX 6.1
;IF ET = AT
@BOX 7.1
;IF A.Z & %10 /= 0
@BOX 8.1
;IF E.Z & %10 = 0 AND FA & %78 /= %20
@BOX 9.1
;IF E.Z & %F =< A.Z
@BOX 10.1
;FAULT(164, 6)
@BOX 11.1
;IF EZ = AZ
@BOX 12.1
;FA ->> 4 & 7 => T
;IF E.K < %10 THEN
    %8000 => B
 ELSE
    ;E.K & %F => B
    ;1 <<- B => B
 FI
;IF ILL.ARG.MASK[T] & B = 0
@BOX 13.1
:: END
@BOX 14.1
;IF E.Z & %10 /= 0
@BOX 15.1
;IF E.Z >= A.Z & %F
@BOX 16.1
;FAULT(164, 6)
@BOX 17.1
;E.Z => ARG^[P + 1]
@BOX 18.1
;IF E.Z > A.Z THEN E.Z => ARG^[P+1] FI
@END
@TITLE FTN11.16.1.9(1,11)
@COL 1S-16T-31R-3C
@COL 18R-2F
@FLOW 1-16N-31-3
@FLOW 16Y-18-2
@BOX 16.0
CONSISTENT CALL TO PROC?
@BOX 18.0
GENERATE ARG SPEC FOR CALL
:FTN11.16.1.4:
@BOX 1.1
::BEGIN
@BOX 2.1
; ->FTN11.16.1B35
::END
@BOX 3.1
;->REDUCE.EXPR.FAULT
@BOX 16.1
;IF [I = 3 AND F = 1] OR
    [I = 4 AND F = 5]
@BOX 18.1
; %800 => EK
; L.LEN OF LP^ => PR
; 1 => PROC.F
; 9-I => K :: ??? JM 9-FEB-83
; G.TL.NAME OF GP^ => TL.NAME
   => L.SPEC.TL.NAME OF L.ALT OF LP^
;FILL.ARG.SPEC(L.ARG.SPEC.P OF L.ALT OF LP^,K,LT,LP,
        AS[AS[AP+4]=>AP1],AP1,D.BIT)
@BOX 31.1
; LP => F.L.PROP.G
; FAULT(127,1)
@END
@TITLE FTN11.16.2(1,11)
@COL 3R-18R-19R-20R-21C
@COL 1S-4T-2T-5T-6R-7T-22R-8T-23T-24T-25R-10T-9R-26T-27R-14T-15R-11T-12R-13F
@ROW 3-7
@ROW 18-8
@FLOW 1-4N-2N-5N-6-7N-22-8N-23N-24N-25-10N-9-26N-27-14constant-15-11N-12-13
@FLOW 2Y-3-21
@FLOW 4Y-7
@FLOW 5Y-7
@FLOW 23Y-10
@FLOW 24Y-19
@FLOW 26Y-14
@FLOW 7Y-18-21
@FLOW 8Y-19-21
@FLOW 10Y-20-21
@FLOW 11Y-13
@FLOW 14not constant-13
@BOX 1.0
CHECK NODES(AP)
@BOX 2.0
ASSIGNMENT WITH INVALID LHS?
@BOX 3.0
FAULT
@BOX 4.0
NOT AN ASSIGNMENT?
@BOX 5.0
LHS NOT A DO VARIABLE
@BOX 6.0
WARNING
@BOX 7.0
EITHER NODE A FN
OR AN ARRAY
OR A SUBROUTINE REFN?
@BOX 8.0
CHECK TYPES COMPATIBLE
INVALID COMBINATIONS ARE
I : L, I : CH
R : L, R : CH
D : L, D : C, D : CH
C : D, C : CH
CH : I, CH : R, CH : D, CH.C
@BOX 9.0
SET RESULTANT TYPE OF
NODE COERCION
RELATIONAL OPERATOR : LOGICAL
ASSIGNMENT : TYPE OF LH NODE
ARITH : TYPE OF GREATER PRECISION
LOGICAL.OP : LOGICAL
CONCATENATION : CHARACTER
@BOX 10.0
CHECK TYPES PERMITTED WITH OPERATOR
INVALID TYPES ARE
+ - /* ** : L, CH
OR AND EQV NEQV : I, R, D, C, CH
// : 1, R, D, C, L
REL OPERATORS : L
COMPLEX REL : OPERATOR
RESTRICTED TO .EQ. .NEQ.
@BOX 11.0
BOTH NODES  NOT CONSTANTS
OR CONSTANT EVALUATION INHIBITED?
@BOX 12.0
EVALUATE CONSTANT TRIPLET
: 11.16.2.0
@BOX 13.0
END
@BOX 14.0
right hand kind?
@BOX 15.0
warning on zero division
@BOX 18.0
FAULT
@BOX 19.0
FAULT
@BOX 20.0
FAULT
@BOX 21.0
REDUCE EXPR
FAULT:11.2:
@BOX 22.0
GET TYPE OF
LH OPD AND RH OPD
NOTE IF ANY IS A POTENTAIL
PSUEDO HOLLERITH
(CHARACTER CONSTANT)
@BOX 23.0
NEITHER OPERAND IS A HOLLERITH
@BOX 24.0
HOLLERITH OR CHARACTER CONSTANT
NOT USED WITH COMPARE OR ASSIGN
@BOX 25.0
NOTE HOLLERITH NODE
ISSUE NON-STANDARD WARNING IF EITHER OPERAND
IS A CHARACTER STRING
@BOX 26.0
character?
@BOX 27.0
process Hollerith and typeless nodes
@BOX 1.1
;PROC CHECK.NODES(AP)
;$IN LH, RH, LH0, RH0, TYP, LHTYP, RHTYP, OP0, OPR, ASS.TYP
;$IN F, LHK, RHK,LHZ,RHZ,Z,H,TYP.K,PR
;REAL64 DIV.CHECK :: ??? JM 15-FEB-83
;ADDR CA
;ADDR LOCAL.PROP LP
;ADDR CONST.PROP CP,CPL,CPR
;$IN IR,I,IL,T,SI,CHR,CHL,SCHL,SCHR
;ADDR [$LO8] CHPL,CHP,CHPR
;$IN TY,TC
;DATAVEC TRUE.C($LO8)
0 6 2 5 1 10
END
:: %FF ILLEGAL
::BIT 4 =1 HOLLERITH COMPARE ALLOWED
::BIT 5 =1 HOLLERITH ASSIGN ALLOWED
::BIT 6,7 = 1 IF NOT ASSIGN/COMPARE
::    SET SIZE FROM LH OPD
::        =2 IF NOT ASSIGN/COMPARE
::    SET SIZE FROM RH OPD
::        =3 IF NOT ASSIGN/COMPARE
::    SET SIZE FROM MAX OF LHZ/RHZ
::BIT 3=1 SIZE=4
;DATAVEC TYPE.CH($LO8)
:: ROWS GIVE LH OPERAND, COLS GIVE RH OPERAND
:: REAL DP CMPLX INT LOG CHAR CHAR.CONST HOLL TYPELESS
   %C0  %C1 %82  %40 %FF  %FF    %70      %70   %00    ::REAL
   %C1  %C1 %FF  %41 %FF  %FF    %71      %71   %01    ::DP
   %42  %FF %C2  %42 %FF  %FF    %FF      %FF   %FF    ::CMPLX
   %80  %81 %82  %C3 %FF  %FF    %73      %73   %03    ::INT
   %FF  %FF %FF  %FF %C4  %FF    %74      %74   %FF    ::LOG
   %FF  %FF %FF  %FF %FF  %05    %05      %FF   %FF    ::CHAR
   %90  %91 %FF  %93 %94  %05    %05      %FF   %1B    ::CHAR.CONST
   %90  %91 %FF  %93 %94  %FF    %FF      %FF   %1B    ::HOLL
   %80  %81 %FF  %83 %FF  %FF    %1B      %1B   %0B    ::TYPELESS
END;
:: OPCH THE ENTRY SPECIFIES TYPE OF OPERANDS PERMITTED
:: BIT ENCODED 1 MEANS OK
;DATAVEC OP.CH($LO8)
%3F  %20  %0   %10  %10  %10  %F   %0
%F   %F   %0   %F   %F   0    %10  %2F
END
@BOX 2.1
IF AS[LH] & %1F /= %12 /= %13 /= %1B /= %1F
@BOX 3.1
;144 => F
@BOX 4.1
;0=>H
;AS[AP] => OP0
;AS[AP+1] => LH
;AS[AP+2] => RH
;IF OP0 & %F=>OPR /= 0
@BOX 5.1
;LOC OF PROPS.T[AS[LH+2]]=>LP
;IF L.SPECS OF LP^ & %400 = 0
@BOX 6.1
;LP => F.L.PROP.G
;FAULT(334,1)
@BOX 7.1
;IF AS[LH] => LH0 & %1F => LHK >= %18 OR AS[RH] => RH0 & %1F => RHK >= %18
      OR LHK = %15 OR RHK = %15
@BOX 8.1
;IF TYPE.CH[LHTYP*9+RHTYP] => TYP.K&%F=>TYP = %F
@BOX 9.1
;IF LH0 & %F = %F THEN 0 => LHZ ELSE LH0 & %E0 => LHZ FI
;IF RH0 & %F = %F THEN 0 => RHZ ELSE RH0 & %E0 => RHZ FI
;IF  OPR = 0 THEN
   ;ASS.TYP => TYP
   ;LHZ => Z
;ELSE IF OPR = 15 THEN
   ;4 => TYP
   ;0 => Z
 ELSE ALTERNATIVE TYP.K ->> 6 FROM
      (IF TYP.K & 8 /= 0 THEN %80 ELSE 0) => Z
     ;LHZ => Z
     ;RHZ => Z
     ;(IF RHZ > LHZ THEN RHZ ELSE LHZ) => Z
     END
;FI FI
;TYP <<- 12 ! Z !> AS[AP]
@BOX 10.1
;1 <<- TYP & OP.CH[OPR] => F
;IF OPR = 15 AND TYP = 2 THEN
   ;IF OP0 & %E0 /= %20 /= %40 THEN
      ;0 => F
   ;FI
;FI
;IF F = 0
@BOX 11.1
 :: ??? JM 15-FEB-83
;IF LHK /= %10 /= %11 OR OP0 & %100 /= 0
@BOX 12.1
#FTN11.16.2.0
@BOX 13.1
;END
@BOX 14.1
 :: ??? JM 15-FEB-83
;IF RHK /= %10 /= %11
@BOX 15.1
 :: ??? JM 15-FEB-83 (new box)
;IF OPR = 12 THEN
    ;CONST OF PROPS.T[AS[RH+2]] => CPR
    ;SELECT CPR^
    ;ALTERNATIVE AS[RH] ->> 12 FROM
       ;REAL.CONST => DIV.CHECK
       ;DP.CONST => DIV.CHECK
       ;(IF R.COMP.CONST = 0.0
            THEN I.COMP.CONST
            ELSE R.COMP.CONST) => DIV.CHECK
       ;INT.CONST => DIV.CHECK
     END :: of ALTERNATIVE
    ;IF DIV.CHECK = 0.0
        THEN FAULT (174, 1)
     FI
 FI
@BOX 18.1
;112=>F
@BOX 19.1
;113=>F
@BOX 20.1
;114=>F
@BOX 21.1
;FAULT(F,0-AS[AP+3])
;->REDUCE.EXPR.FAULT
@BOX 22.1
;IF LH0->>12=>ASS.TYP=>LH.TYP=5 AND LHK=%10 THEN
    6 => LH.TYP FI
;IF RH0->>12=>RH.TYP=5 AND RHK=%10 THEN
    6 => RH.TYP FI
@BOX 23.1
;IF TYP.K & %30 = 0
@BOX 24.1
;IF TYP & %10/=0 AND OPR /= 15
  OR TYP & %20 /= 0 AND OPR /= 0
@BOX 25.1
; 1 => H
;IF LH.TYP = 6 OR RH.TYP = 6 THEN
   ;FAULT(167, 6)
;FI
@BOX 26.1
; IF TYP = 5
@BOX 27.1
#FTN11.16.2.6
@END
@TITLE FTN11.16.2.0(1,10)
@COL 20N-11T-12R
@COL 1S-2T-5T-6R-7R-8R-9F
@COL 13T-15R-16R-17R-18R
@ROW 20-5-13
@FLOW 1-2N-5N-6-7-8-9
@FLOW 2Y-13N-15-16-17-8
@FLOW 13Y-18-8
@FLOW 5Y-20-11N-12-8
@FLOW 11Y-9
@BOX 1.0
EVALUATE A CONSTANT
NODE
@BOX 2.0
ALLOCATE A CONSTANT
CHARACTER COERCION
@BOX 11.0
RHS NOT INT
@BOX 5.0
**
@BOX 6.0
IF EITHER CONSTANT OF
DIFFERENT TYPE CONVERT CONSTANT
OF LEAST PRECISION : 11.14:
@BOX 7.0
COERCE NODES BY
APPLYING
ARITH FN +, -, /, *
LOGICAL FN
OR
RELATIONAL FN
@BOX 8.0
MAKE NODE INTO A
TERMINAL NODE
@BOX 9.0
END
@BOX 12.0
EVALUATE ACCORDING TO
LH TYPE
@BOX 13.0
RELATIONAL OPERATOR?
@BOX 15.0
ALLOCATE A NEW CHARACTER
CONSTANT
OF REQUIRED SIZE
@BOX 16.0
ADD CHAR CONSTANT OF
LH NODE TO IT
@BOX 17.0
ADD CHAR CONSTANT OF
RH NODE TO IT
@BOX 18.0
COMPARE CHAR CONSTANTS
SET LOGICAL RESULT
@BOX 2.1
#FTN11.16.2.1
;MAKE.CONST.PROP(LINE.SPACE) => CP
;IF ASSTYP = 5
@BOX 5.1
;IF OPR = 6
@BOX 6.1
;CHECK.CONST(LH,LHTYP,RHTYP)
;CHECK.CONST(RH,RHTYP,LHTYP)
@BOX 7.1
#FTN11.16.2.3
@BOX 8.1
#FTN11.16.2.4
@BOX 9.1
;B9:
@BOX 11.1
;IF RHTYP /= 3
@BOX 12.1
#FTN11.16.2.2
@BOX 13.1
;ADDRESS OF PROPS.T[AS[LH+2]] => CA
;MAKE($LO8,4095,CA) => CHPL
;ADDRESS OF PROPS.T[AS[RH+2]] => CA
;MAKE($LO8,4095,CA) => CHPR
;IF OPR = 15
@BOX 15.1
;-1 => IL => IR
;WHILE CHPL^[1+>IL] /= 0 DO OD
;WHILE CHPR^[1+>IR] /= 0 DO OD
;MAKE.LO8(IL+IR+1,LINE.SPACE) => CHP
@BOX 16.1
;-1 => I
;WHILE CHPL^[1+>I] => CHP^[I] /= 0 DO OD
@BOX 17.1
;-1 => I
;WHILE CHPR^[1+>I] => CHP^[IL+I] /= 0 DO OD
@BOX 18.1
#FTN11.16.2.5
@END
@TITLE FTN11.16.2.1(1,11)
@COL 1S
@FLOW 1
@BOX 1.0
COMPLEX ARITHMETIC PROCEDURES
@BOX 1.1
 ;PSPEC COMP.MULT()
;PSPEC COMP.DIV()
;PROC COMP.MULT
;(RCR.G * RCL.G) - (ICR.G * ICL.G) => RR.G
;(RCR.G * ICL.G) + (RCL.G * ICR.G) => ICL.G
    ;RR.G => RCL.G
;END
;PROC COMP.DIV
;(RCL.G * RCL.G) + (ICL.G * ICL.G) => RR.G
;(RCR.G * RCL.G) + (ICR.G * ICL.G) / RR.G => RL.G
;(RCL.G * ICR.G) - (RCR.G * ICL.G) / RR.G => ICL.G
    ;RL.G => RCL.G
    ;END
@END
@TITLE FTN11.16.2.2(1,10)
@COL 1S
@FLOW 1
@BOX 1.0
EVALUATE ACCORDING TO LH TYPE
@BOX 1.1
;CONST OF PROPS.T[AS[LH+2]] => CPL
;CONST OF PROPS.T[AS[RH+2]] => CPR
;INT.CONST OF CPR^ => I
;IF I => SI < 0 THEN
   ;0 - I => I
;FI
;ALTERNATIVE LHTYP FROM
   ;BEGIN
      ;1. => RL.G
      ;REAL.CONST OF CPL^ => RR.G
      ;WHILE 1 -> I >= 0 DO
         ;RR.G *> RL.G
      ;OD
      ;IF SI < 0 THEN
         ;1. / RL.G => RL.G
      ;FI
   ;END
   ;BEGIN
      ;1. => DPL.G
      ;D.P.CONST OF CPL^ => DPR.G
      ;WHILE 1 -> I >= 0 DO
         ;DP.R.G *> DP.L.G
      ;OD
      ;IF SI < 0 THEN
         ;1. / DP.L.G => D.P.L.G
      ;FI
   ;END
   ;BEGIN
      ;1. => R.C.L.G
      ;0. => I.C.L.G :: ??? JM 1-FEB-83
      ;R.COMP.CONST OF CPL^ => R.C.R.G
      ;I.COMP.CONST OF CPL^ => I.C.R.G
      ;WHILE 1 -> I >= 0 DO
        COMP.MULT()
      ;OD
      ;IF SI < 0 THEN
         ;1. => R.C.R.G
         ;0. => I.C.R.G :: ??? JM 1-FEB-83
          ;COMP.DIV()
      ;FI
   ;END
   ;BEGIN
      ;1 => IL
      ;INT.CONST OF CPL^ => IR
      ;WHILE 1 -> I >= 0 DO
         ;IR *> IL
      ;OD
      ;IF SI < 0 THEN
         ;1 / IL => IL
      ;FI
   ;END
;END
@END
@TITLE FTN11.16.2.3(1,10)
@COL 1S-2R-3R-4R-6R-8R-10R-13F
@COL 12R-5R-7R-9R-11R
@ROW 4-5
@FLOW 1-2-3
@FLOW 4-13
@FLOW 5-13
@FLOW 6-13
@FLOW 7-13
@FLOW 8-13
@FLOW 9-13
@FLOW 10-13
@FLOW 11-13
@FLOW 12-13
@BOX 1.0
COERCE NODES
@BOX 2.0
LOAD NODE VALUES
@BOX 3.0
SWITCH ON OPR
@BOX 4.0
NEQV
@BOX 5.0
EQV
@BOX 6.0
AND
@BOX 7.0
OR
@BOX 8.0
PLUS
@BOX 9.0
MINUS
@BOX 10.0
MULT
@BOX 11.0
DIV
@BOX 12.0
COMP
@BOX 13.0
END
@BOX 1.1
@BOX 2.1
;CONST OF PROPS.T[AS[LH+2]] => CPL
;CONST OF PROPS.T[AS[RH+2]] => CPR
;ALTERNATIVE AS[LH] ->> 12 => LHTYP FROM
   ;BEGIN
      ;REAL.CONST OF CPL^ => RL.G
      ;REAL.CONST OF CPR^ => RR.G
   ;END
   ;BEGIN
      ;DP.CONST OF CPL^ => DPL.G
      ;DP.CONST OF CPR^ => DPR.G
   ;END
   ;BEGIN
      ;R.COMP.CONST OF CPL^ => RCL.G
      ;I.COMP.CONST OF CPL^ => ICL.G
      ;R.COMP.CONST OF CPR^ => RCR.G
      ;I.COMP.CONST OF CPR^ => ICR.G
   ;END
   ;BEGIN
      ;INT.CONST OF CPL^ => IL
      ;INT.CONST OF CPR^ => IR
   ;END
   ;BEGIN
      ;LOG.CONST OF CPL^ => IL
      ;LOG.CONST OF CPR^ => IR
   ;END
;END
@BOX 3.1
;SWITCH OPR \
   B9,B9,B9,C.NEQV,
   CAND,COR,B9,B9,
   CPLUS,CMINUS,B9,CMULT,
   CDIV,B9,CEQV,CCOMP
@BOX 4.1
;C.NEQV:
;IR -=> IL
@BOX 6.1
;C.AND:
;IR &> IL
@BOX 7.1
;COR:
;IR !> IL
@BOX 8.1
;CPLUS:
;ALTERNATIVE LHTYP FROM
   ;RR.G +> RL.G
   ;DPR.G +> DPL.G
   ;BEGIN
      ;RCR.G +> RCL.G
      ;ICR.G +> ICL.G
   ;END
   ;IR +> IL
;END
@BOX 9.1
;CMINUS:
;ALTERNATIVE LHTYP FROM
   ;RR.G -> RL.G
   ;DPR.G -> DPL.G
   ;BEGIN
      ;RCR.G -> RCL.G
      ;ICR.G -> ICL.G
   ;END
   ;IR -> IL
;END
@BOX 10.1
;CMULT:
;ALTERNATIVE LHTYP FROM
   ;RR.G *> RLG
   ;DPR.G *> DPLG
;COMP.MULT()
   ;IR *> IL
;END
@BOX 11.1
;CDIV:
 :: ??? JM 15-FEB-83
;IF DIV.CHECK /= 0.0
    THEN ALTERNATIVE LHTYP FROM
         ;RR.G /> RLG
         ;DPR.G /> DPL.G
         ;COMP.DIV()
         ;IR /> IL
         END
    ELSE ALTERNATIVE LHTYP FROM
         ;BEGIN END :: Here we would like to put the value
         ;BEGIN END :: maximum.magnitude * (a,b)/SQRT(a**2 + b**2),
         ;BEGIN END :: where b=0 except perhaps for type complex.
         ;BEGIN END
         END
 FI
@BOX 5.1
;CEQV:
;IL -= IR -= 1 => IL
@BOX 12.1
;CCOMP:
;0 => T
;ALTERNATIVE LHTYP FROM
   ;BEGIN
      ;IF RLG /= RRG THEN
         ;IF RLG < RRG THEN
            ;1 => T
         ;ELSE
            ;2 => T
      ;FI FI
   ;END
   ;BEGIN
      ;IF DPLG /= DPRG THEN
         ;IF DPLG < DPRG THEN
            ;1 => T
         ;ELSE
            ;2 => T
      ;FI FI
   ;END
   ;BEGIN
      ;IF RCRG /= RCLG OR ICRG /= ICLG THEN
         ;1 => T
      ;FI
   ;END
   ;BEGIN
      ;IF IL /= IR THEN
         ;IF IL < IR THEN
            ;1 => T
         ;ELSE
            ;2 => T
      ;FI FI
   ;END
;END
@BOX 13.1
@END
@TITLE FTN11.16.2.4(1,11)
@COL 1S
@FLOW 1
@BOX 1.0
MAKE NODE INTO TERMINAL NODE
@BOX 1.1
;IF TYP /= 5 THEN
   ;IF OPR = 15 THEN
;0 => I.L
;IF TRUE.C[OP0->>5 & 7 -1] => TC & 3 = T
   OR TC ->> 2 & 3 = T THEN
   ;1 => I.L
;FI FI
      ;ALTERNATIVE TYP FROM
         ;RLG => REAL.CONST OF CP^
         ;DPLG => DP.CONST OF CP^
         ;BEGIN
            ;R.C.L.G => R.COMP.CONST OF CP^
             ;I.C.L.G => I.COMP.CONST OF CP^
         ;END
         ;I.L => INT.CONST OF CP^
         ;I.L => LOG.CONST OF CP^
      ;END
      ;CONST.PRECISION (CP, TYP) => PR :: ??? JM 31-DEC-82
      ;CP => CONST OF PROPS.T[ AS[AP+2]]
;ELSE
   ;BYTE(CHP) => ADDRESS OF PROPS.T[AS[AP+2]]
;FI
;TYP <<- 12 ! (PR <<- 5) ! %10 => AS[AP] :: ??? JM 31-DEC-82
@END
@TITLE FTN11.16.2.5(1,6)
@COL 1S
@FLOW 1
@BOX 1.0
COMPARE CHAR CONSTS
SET LOGICAL RESULTS
@BOX 1.1
;-1 => T => IL => IR
;WHILE T < 0 DO
   ;IF CHPL^[1+>IL] => SCHL => CHL = 0 THEN
      ;SPACE.L => CHL
      ; 1 -> IL
   ;FI
   ;IF CHPR^[1+>IR] => CHR => SCHR = 0 THEN
      ;SPACE.L => CHR
      ; 1 -> IR
   ;FI
   ;IF CHL = CHR THEN
      ;IF SCHL = 0 AND SCHR = 0 THEN
         ;0 => T
      ;FI
   ;ELSE
      ;IF CHL < CHR THEN
         ;1 => T
      ;ELSE
         ;2 => T
      ;FI
   ;FI
   ;OD
@END
@TITLE FTN11.16.2.6(1,11)
@COL 1S-2T-3T-4R-5T-6T-7R-8F
@COL 9R-10R
@ROW 3-9
@ROW 6-10
@FLOW 1-2-3-4-5-6-7-8
@FLOW 2-9-6
@FLOW 3-5
@FLOW 5-10-8
@FLOW 6-8
@BOX 1.0
PROCESS HOLLERITHS AND
TYPELESS CONSTANTS
@BOX 2.0
LHS A HOLLERITH OR
A CHARACTER(BUT TREATED AS A HOLLERITH)?
@BOX 3.0
LHS NOT A TYPELESS CONSTANT?
@BOX 4.0
CREATE CONSTANT OF
RHS TYPE AND SIZE
@BOX 5.0
RHS A HOLLERITH OR
A CHARACTER(BUT TREATED AS A HOLLERITH)?
@BOX 6.0
LHS NOT A TYPELESS CONSTANT
@BOX 7.0
CREATE CONSTANT OF LHS
TYPE AND SIZE
@BOX 8.0
END
@BOX 9.0
CREATE CONSTANT OF RHS
TYPE AND SIZE
[FTN11.26]
@BOX 10.0
CREATE CONSTANT OF LHS
TYPE AND SIZE
[FTN11.26]
@BOX 1.1
:: BEGIN
@BOX 2.1
;IF LH.TYP = 7 OR [LH.TYP = 6 AND H = 1]
@BOX 3.1
;IF LH.TYP /= 8
@BOX 4.1
;PR.TYPELESS (LH,RH.TYP,RHZ->>5)
@BOX 5.1
;IF RH.TYP = 7 OR [RH.TYP = 6 AND H = 1]
@BOX 6.1
;IF RH.TYP /= 8
@BOX 7.1
;PR.TYPELESS (RH,LH.TYP,LHZ->>5)
@BOX 8.1
:: END
@BOX 9.1
;PR.HOLLERITH (LH, RH.TYP, RHZ->>5)
@BOX 10.1
;PR.HOLLERITH (RH, LH.TYP, LHZ->>5)
@END
@TITLE FTN11.17(1,6)
@COL 1S-2R-3R-4R-5F
@FLOW 1-2-3-4-5
@BOX 1.0
CHECK.EXPR(AP)
@BOX 2.0
INTERNAL PROCS
CHECK NODE:11.17.1:
@BOX 3.0
SET EXPR TO CONSTANT
@BOX 4.0
CHECK NODE:11.17.1:
@BOX 5.0
END
@BOX 1.1
;PROC CHECK.EXPR(AP)
;$IN EXPR.STATUS
@BOX 2.1
;PSPEC CHECK.NODE($IN)
#FTN11.17.1
@BOX 3.1
;0=>EXPR.STATUS
@BOX 4.1
;CHECK.NODE(AP)
@BOX 5.1
;EXPR.STATUS=>CHECK.EXPR
;END
@END
@TITLE FTN11.17.1(1,6)
@COL 1S-2R-3T-4R-5F
@COL 6R
@ROW 4-6
@FLOW 1-2-3N-4-5
@FLOW 3Y-6-5
@BOX 1.0
CHECK.NODE(AP)
@BOX 2.0
INTERNAL PROCS
CHECK.TERMINAL.NODE:11.17.2:
@BOX 3.0
NODE TERMINAL?
@BOX 4.0
CHECK LH NODE :11.17.1:
CHECK RH NODE
@BOX 5.0
END
@BOX 6.0
CHECK TERMINAL NODE
:11.17.2:
@BOX 1.1
;PROC CHECK.NODE(AP)

@BOX 2.1
;PSPEC CHECK.TERM.NODE($IN)
#FTN11.17.2
@BOX 3.1
;IF AS[AP] & %10 /= 0
@BOX 4.1
;CHECK.NODE(AS[AP+1])
;CHECK.NODE(AS[AP+2])
@BOX 5.1
;END
@BOX 6.1
;CHECK.TERM.NODE(AP)
@END
@TITLE FTN11.17.2(1,10)
@COL 1S-2T-3T-4R-5F
@FLOW 1-2N-3N-4-5
@FLOW 2Y-5
@FLOW 3Y-5
@BOX 1.0
CHECK TERMINAL NODE(AP)
@BOX 2.0
CONSTANT?
@BOX 3.0
NAME OF CONSTANT?
@BOX 4.0
SET EXPR STATUS TO VARIABLE
@BOX 5.0
END
@BOX 1.1
;PROC CHECK.TERM.NODE(AP)
;ADDR LOCAL.PROP LP


@BOX 2.1
;IF AS[AP] & %F = 0
@BOX 3.1
;LOC OF PROPS.T[AS[AP+2]]=>LP
;IF  L.KIND OF LP^ = 3
@BOX 4.1
;1 => EXPR.STATUS
@BOX 5.1
;END
@END
@TITLE FTN11.19(1,6)
@COL 1S-2T-3R-4R-5F
@FLOW 1-2N-3-4-5
@FLOW 2Y-5
@BOX 1.0
CREATE CHAR EXPR DUMP
(EXPR)NAME
@BOX 2.0
CALCULATE EXPR LENGTH:11.13:
FAULTY?
@BOX 3.0
DECLARE A DUMP VARIABLE FOR
EXPR
@BOX 4.0
PLANT
 MOV
 LHS=DUMP
 RHS=EXPR:11.3:
 EMOV
@BOX 5.0
END
@BOX 1.1
;PROC CREATE.CHAR.EXPR.DUMP(AP)
;$IN L
;LITERAL/ADDR [$LO8] NILSTR=
@BOX 2.1
;IF CALC.CHAR.EXPR.LENGTH(AP)=>L=>CHAR.DUMP.LENGTH=>CREATE.CHAR.EXPR.DUMP < 0
@BOX 3.1
;TL.S.DECL(NIL.STR,%80,L)
@BOX 4.1
;SET.A.TYPE(5,0) :: ??? JM 31-DEC-82
;TL.PL(%22,0)
;TL.PL(%20,MUTL.N.G=>CREATE.CHAR.EXPR.DUMP)
;1+>MUTL.N.G
;CODE.EXPR(AP,%21)
;TL.PL(%23,0)
@BOX 5.1
;END
@END



@TITLE FTN11.20(1,10)
@COL 1S-2R-3R-4F
@FLOW 1-2-3-4
@BOX 1.0
LOAD.REGS.FOR.CHAR.ARRAY.EL.NODE(AP)
@BOX 2.0
CODE.SUBSCRIPTS:11.4:
@BOX 3.0
LOAD.CHAR.ARRAY.EL.REFN:11.21:
@BOX 4.0
END
@BOX 1.1
;PROC LOAD.REGS.FOR.CHAR.ARRAY.EL.NODE(AP)
;ADDR LOCAL.PROP LP
@BOX 2.1
;CODE.SUBSCRIPTS(AS[AP+2],AS[AP+4],0)
@BOX 3.1
;LOC OF PROPS.T[AS[AP+2]]=>LP
;LOAD.REGS.FOR.CHAR.ARRAY.EL.REFN(LP)
@BOX 4.1
;END
@END

@TITLE FTN11.21(1,11)
@COL 1S-2R-3T-4R-5F
@FLOW 1-2-3N-4-5
@FLOW 3Y-5
@BOX 1.0
LOAD.REGS.FOR.CHAR.ARRAY.EL.REFN(LP)
@BOX 2.0
PLANT LOAD D= OR D= REF
@BOX 3.0
ARRAY ELEMENTS HAVE A
CHAR LENGTH OF ONE?
@BOX 4.0
PLANT
  B * LENGTH
@BOX 5.0
END
@BOX 6.0
PLANT SELECT EL
@BOX 1.1
;PROC LOAD.REGS.FOR.CHAR.ARRAY.EL.REFN(LP)
;$IN T
@BOX 2.1
;IF L.SPECS OF LP^ & %200 /= 0 THEN
  ;%62=>T
;ELSE
  ;%61=>T
;FI
;TL.PL(T,L.TL.NAME OF LP^)
@BOX 3.1
;IF L.LEN OF LP^ => T = 1
@BOX 4.1
;IF T >= 0 THEN
   ;TL.C.LIT.16(%44,T) :: ??? JM 31-DEC-82
   ;0 => T
;FI
;TL.PL(11,0-T)
@BOX 5.1
;END
@END



@TITLE FTN11.22(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
PLANT STK LB(INDEX,RESULT.MODE)
@BOX 2.0
DECLARE ROUTINE TO MUTL
PLANT STK.L
@BOX 3.0
END
@BOX 1.1
;PROC PL.STK.LB(INDEX,RES.MODE)
;ADDR[$LO8] NAME
;$LO32 FN
;$IN NPAR,J,MN
;PSPEC PARAM.N($IN)/$IN
;PROC PARAM.N(N)
;IF FIND.P(FN,-1,N)=>PARAM.N > 256 THEN
   ;IF PARAM.N & 3 = 1 THEN
      ;%109 => PARAM.N
   ;ELSE
      ;FMT.DICT.TYPE.G + 3 => PARAM.N
   ;FI
;FI
;END
@BOX 2.1
;IF RW.PROCS[INDEX] => MN = 0 THEN
     TL.PROC.SPEC(PART(^IO.NAMES,NAME.INDEX[INDEX],NAME.INDEX[INDEX+1]-1)
         => NAME,%8008)
    ;FIND.N(NAME,0) => FN
    ;FIND.P(FN,-1,0) => NPAR
    ;FOR J < NPAR DO
       TL.PROC.PARAM(PARAM.N(J+1),0) OD
    ;TL.PROC.RESULT(PARAM.N(NPAR+1))
    ; MUTL.N.G => RW.PROCS[INDEX] => MN + 1 => MUTL.N.G
 FI
;TL.PL(%40,MN)
@BOX 3.1
END
@END
@TITLE FTN11.23(1,6)
@COL 1S-2T-3R-5F
@COL 4R
@ROW 3-4
@FLOW 1-2N-3-5
@FLOW 2Y-4-5
@BOX 1.0
PL.VAR.OP(OP,VAR)
@BOX 2.0
DUMMY ARGUMENT?
@BOX 3.0
PLANT ORDER
@BOX 4.0
PLANT D=REF
PLANT ORDER
@BOX 5.0
END
@BOB 1.1
;PROC PL.VAR.OP(OP,VAR)
;$IN N
@BOX 2.1
;L.TL.NAME OF VAR^ => N
;IF L.SPECS OF VAR^ & %200 /= 0
@BOX 3.1
;TL.PL(OP,N)
@BOX 4.1
;TL.PL(%62,N)
;TL.PL(OP,%1004)
@BOX 5.1
END
@END
@TITLE FTN11.24(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
PLANT STACK PAR
@BOX 2.0
LOAD CURRENT LITERAL
STORE IN A
PLANT STK.PAR
@BOX 3.0
END
@BOX 1.1
; PROC PL.STK.PAR(LIT)
@BOX 2.1
; SET.A.TYPE(3,1) :: ??? JM 31-DEC-82
; TL.C.LIT.16(%44,LIT) :: ??? JM 31-DEC-82
; TL.PL(%22,0)
; TL.PL(%41,%3000)
@BOX 3.1
END
@END
@TITLE FTN11.25(1,10)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
STR.SIZE(AP)
@BOX 2.0
CALCULATE CHARACTER SIZE
OF NODE
@BOX 3.0
END
@BOX1.1
;PROC STR.SIZE(AP)
;ADDR A
@BOX 2.1
;PSPEC SPEC.VALUE($IN)/$IN
;PROC SPEC.VALUE(AP)
;ADDR CONST.PROP CP
;$IN K
:: ;REDUCE.EXPR(AP)
;IF AS[AP] => K & %701F /= %3010 /= %3011 THEN
   ;-1 => SPEC.VALUE
;ELSE
   ;CONST OF PROPS.T[AS[AP+2]] => C.P
   ;INT.CONST OF C.P^ => SPEC.VALUE
;FI
;END
;ADDR LOCAL.PROP LP
;$IN K,N0,SS,SF,L,SAP,AP1
;ADDR [$LO8] P
;IF AS[AP] => N0 & %F => K <1 THEN
;-1 => L
;ADDRESS OF PROPS.T[AS[AP+2]] => A
;MAKE($LO8,4095,A) => P
;WHILE P^[1+>L] /= 0 DO OD
;ELSE
   ;LOC OF PROPS.T[AS[AP+2]] => L.P
   ;IF N0 & %800 = 0 THEN
      ;L.LEN OF L.P^ => L
   ;ELSE
      ;AS[AP+4] => SAP   :: SUBSTRING
      ;IF N0 & %400 /=0 THEN
         ;AS[AP+5] => SAP
      ;FI
      ;IF AS[SAP] => AP1=0 THEN
         ;1 => SS
      ;ELSE
         ;SPEC.VALUE(AP1) => SS
      ;FI
   ;IF AS[SAP+1] => AP1 = 0 THEN
         ;L.LEN OF L.P^ => SF
   ;ELSE
         ;SPEC.VALUE(AP1) => SF
   ;FI
   ;IF SS < 1 OR SF < 1 THEN
         ;-1 => L
   ;ELSE
         ;SF+1 -SS => L
   ;FI
;FI FI
;L => STR.SIZE
@BOX 3.1
;END
@END
@TITLE FTN11.26(1,11)
@COL 1S-2T-3R-4T-5R-7R-8F
@COL 10N-9R
@ROW 4-10
@FLOW 1-2-3-4-5-7-8
@FLOW 2-4
@FLOW 4-10-9-5
@BOX 1.0
PROCESS HOLLERITH CONSTANT (AS,TYPE,SIZE)
@BOX 2.0
TYPE = TYPELESS
@BOX 3.0
SET TYPE = INTEGER
    SIZE = 32 BIT
@BOX 4.0
SIZE OF HOLLERITH GREATER
THAN REQUIRED SIZE?
@BOX 5.0
CREATE HOLLERITH VALUE
OF REQUIRED SIZE
@BOX 7.0
UPDATE NODE FOR
TYPE AND SIZE
@BOX 8.0
END
@BOX 1.1
;PROC PR.HOLLERITH (AP, T, Z)
;$IN MAX.HZ, HZ, P
;ADDR A
;ADDR [$LO8] C
;$LO8 CH
;ADDR CONST.PROP CP
@BOX 2.1
;IF T /= 8
@BOX 3.1
;3 => T
;2 => Z
@BOX 4.1
;MAKE.CONST.PROP (LOCAL.SPACE) => CP
;1 <<- 2 => MAX.HZ
;-1 => HZ
;ADDRESS OF PROPS.T[AS[AP+2]=>P] => A
;MAKE ($LO8, 1320, A) => C
;WHILE C^[1+>HZ] => CH /= 0 DO
       IF HZ < 8 THEN
          CH => H.CONST[HZ] OF CP^
       FI
 OD
;Z => H.PR OF CP^
;IF HZ > MAX.HZ
@BOX 5.1
;WHILE HZ < 8 DO
       SPACE.L => H.CONST[HZ] OF CP^
      ;1 +> HZ
 OD
@BOX 7.1
;CP => CONST OF PROPS.T[P]
;AS[AP] & %0E1F ! %100 ! (T <<- 12) ! (Z <<- 5) => AS[AP]
@BOX 8.1
;END
@BOX 9.1
;MAX.HZ => F.I.G
;FAULT (165, 7)
@END
@TITLE FTN11.27(1,11)
@COL 1S-2T-3R-4T-5R-6R-7F
@COL 8R
@ROW 5-8
@FLOW 1-2N-3-4N-5-6-7
@FLOW 2Y-4
@FLOW 4Y-8-5
@BOX 1.0
PROCESS TYPELESS CONST (AS, TYPE, SIZE)
@BOX 2.0
TYPE = HOLL
@BOX 3.0
SET TYPE = INTEGER
    SIZE = 32 BIT
@BOX 4.0
TYPELESS CONSTANT TOO BIG?
@BOX 5.0
CHANGE TYPE OF CONSTANT
@BOX 6.0
UPDATE NODE FOR
TYPE AND SIZE
@BOX 7.0
END
@BOX 8.0
FAULT
@BOX 1.1
;PROC PR.TYPELESS (AP, T, Z)
;$IN T.Z, N, P
;$LO64 V
;ADDR CONST.PROP CP
@BOX 2.1
;IF T /= 7
@BOX 3.1
;3 => T
;2 => Z
@BOX 4.1
;1 <<- Z => T.Z <<-3 => N
;CONST OF PROPS.T[AS[AP+2]=>P]=>CP
;IF T.CONST OF CP^ => V ->> N /= 0
@BOX 5.1
;CHANGE.CONST.TYPE (CP, 8, T)
@BOX 6.1
;AS[AP] & %F1F ! (T <<- 12) ! (Z <<- 5) => AS[AP]
@BOX 7.1
;END
@BOX 8.1
;T.Z => F.I.G
;FAULT (166,7)
@END
@TITLE FTN11.28(1,11)
@COL 1S-9T-2T-3T-4R-5R-6R-7F
@COL 8R
@ROW 8-3
@FLOW 1-9N-2-3-4-5-6-7
@FLOW 9Y-6
@FLOW 2-8-5
@FLOW 3-7
@BOX 1.0
SET.B.TYPE (TYPE)
@BOX 2.0
CONV?
@BOX 3.0
MODE ALREADY CORRECT
@BOX 4.0
SET FN = BMODE
@BOX 5.0
PLANT BMODE/BCONV
@BOX 6.0
REMEMBER TYPE
@BOX 7.0
END
@BOX 8.0
SET FN = BCONV
@BOX 9.0
32 BIT INDEXING ONLY?
@BOX 1.1
;PROC SET.B.TYPE(TYP)
;$IN FN
;DATAVEC BM ($LO8)
  %40 %44 %4C
 END
@BOX 2.1
;IF TYP & %10 /=0
@BOX 3.1
;IF TYP = CUR.B.TYPE.G
@BOX 4.1
;%56 => FN
@BOX 5.1
;TL.PL (FN, BM[TYP])
@BOX 6.1
;TYP => CUR.B.TYPE.G
@BOX 7.1
;END
@BOX 8.1
;%55 => FN
;7 &> TYP
@BOX 9.1
;IF MIN.IND.Z.G = 2
@END
@TITLE FTN11.29(1,11)
@COL 1S-8T-2T-3T-4R-5F
@COL 9R-6R
@COL 7R
@ROW 9-2
@ROW 3-7
@ROW 6-4
@FLOW 1-8-2-3-4-5
@FLOW 8-9-5
@FLOW 2-7-5
@FLOW 3-6-5
@BOX 1.0
PROC CONST.PRECISION (CONST.PTR, TYPE)
@BOX 2.0
8 BIT CONSTANT?
@BOX 3.0
16 BIT CONSTANT?
@BOX 4.0
SET 32 BIT PRECISION
@BOX 5.0
END
@BOX 6.0
SET 16 BIT PRECISION
@BOX 7.0
SEDT 8 BIT PRECISION
@BOX 8.0
NOT INTEGER?
@BOX 9.0
SET PRECISION
@BOX 1.1
;PROC  CONST.PRECISION (C.P, TYP)
;$IN32 V
;$IN I
;DATAVEC PREC ($LO8)
  2 3 3 0 0
 END
@BOX 2.1
;IF INT.CONST OF C.P^ => V < 128 >= -128
@BOX 3.1
;IF V < 32768 >= -32768
@BOX 4.1
;2 => I
@BOX 5.1
;I => CONST.PRECISION
;END
@BOX 6.1
;1 => I
@BOX 7.1
;0 => I
@BOX 8.1
;IF TYP /= 3
@BOX 9.1
;PREC[TYP] => I
@END
