@X @~
~L3 COUK1247
80
~V7 56 2 -5
~D10
~H                    MUSS
~
~
~D10
~H             FTN051
~D10
~MMANCHESTER UNIVERSITY  -  CONFIDENTIAL~
~
~
                                                           ISSUE 10~
~V9 -1
~P
~V9 1
~YFTN051
~S1~M~OFORTRAN 77 COMPILER IMPLEMENTATION DESCRIPTION
~S1~M~OSection 5
~S1~OSection 5. Specification Statement Processing
~S1~O1.1 General Description
~BThis section of the compiler performs the semantic actions for the
specification statements of the Fortran 77 program. The specification
statements that are processed by this section are:~
~3
~
  a) TYPE STATEMENTS~
          I) REAL~
         II) DOUBLE PRECISION~
        III) COMPLEX~
         IV) INTEGER~
          V) LOGICAL~
         VI) CHARACTER~
  b) DIMENSION~
  c) EXTERNAL~
  d) INTRINSIC~
  e) COMMON~
  f) EQUIVALENCE~
  g) PARAMETER~
  h) SAVE~
  i) IMPLICIT~
~0
~BThe actions taken by the semantics for each statement involve error
checking, updating of the compilers property tables and remembering
the relevant data from each statement. No object code or declarations are genera
ted
in this section, because until all declarations have been processed
the complete specification of an object is not available. In Fortran
most of the specification statements can occur in any order, and not
all items need to be explicitly declared, therefore the specification
statement may not give a complete description of the items used in
each Fortran subprogram. The error checking (such as for EQUIVALENCE's),
code generation and storage allocation that cannot be done in this
section is done in section 6.
~BThe semantics for some statements may involve the evaluation of
constant expressions at compile time, to obtain a constant. This occurs
when handling array declarers, array element descriptions and substring
descriptions in Equivalence and values in the parameter statement. In a
function or subroutine subprogram the array declarer may be an adjustable
dummy array involving dummy arguments, in which case the analysis record
of the expression is saved for later coding in section 6.
~S1~O2. Interfaces
~S1~O2.1 Section Interfaces Used
~
   Section  1:   (Configuration Section)~
   Section  2:   (Statement Driver)~
   Section  4:   (Syntax Analysis)~
   Section 11:   (Expression Evaluation)~
   Section 12:   (Compiler property tables)~
   Section 13:   (Fault Monitoring)~
~S1~O2.2 Section Interface
~
Exported Scalars:~
   ALL.SAVE.G~
   AS.DUMP.G~
~
Exported Procedures:~
   TYPE~
   DIMENSION~
   EXTERNAL~
   INTRINSIC~
   COMMON~
   EQUIVALENCE~
   PARAMETER~
   SAVE~
   IMPLICIT~
   GET.LENGTH~
~S1~O3. Implementation
~S1~O3.1 Outline of Operation
~S1~O3.1.1 TYPE()
~BThis semantic routine checks the type statements. Each item in the
type statement is checked to ensure that it may occur in the type
statement. The item is in error when it has already been typed in the
subprogram, or is the name of the enclosing subprogram (in BLOCKDATA,
SUBROUTINE and PROGRAM), or is a constant parameter name, or an implicit
function of the wrong type. If an array declarer is present this is
processed by DECL ARRAY. If the type is CHARACTER the length specification
is processed by GET LENGTH. Each valid name has its type (and dimension)
information added to the property table.
~S1~O3.1.2  DIMENSION()
~BThis processes the DIMENSION statement. All items in the list of
names are checked for any name that may not be dimensioned, such as
the name of the enclosing subprogram, and external or implicit
subprogram or a constant parameter. The array declarers are processed
by DECL ARRAY.
~S1~O3.1.3 EXTERNAL()
~BThis processes the EXTERNAL statement. All items in the list of
names are checked for any name that may not be an external
subprogram, such as a constant parameter, the name of the enclosing
subprogram, an equivalenced item, a common item, an intrinsic item,
a dimensioned item, a common block name, a saved item or an item
previously specified as external. Each valid name is given external
subprogram properties in the property table.
~S1~O3.1.4 INTRINSIC()
~BThis processes the INTRINSIC statement. All items are checked for
any name that may not be an intrinsic function, such as parameter
constants, external subprograms, equivalenced items, items in
common, saved items, items previously declared to be intrinsic or
names not known as intrinsic functions. If the intrinsic function is
recognised it is given intrinsic properties in the property table.
~S1~O3.1.5 COMMON()
~BThis processes the COMMON statement. The common block name (when
present) is checked to ensure that
it does not clash with any constant
parameters, external subprogram or intrinsic item. Each item in the
common block is checked to ensure it has not previously been in a
common block, or an external, or intrinsic, or parameter, or saved,
or is the name of the enclosing subprogram, or a dummy argument. If
any array declarer is present it is processed by DECL ARRAY. Valid
common blocks and common block items are added to the common block
lists for later processing in section 6.
~BNot all the error checking can be done at this stage and must be
performed later in section 6, this is because the declaration statements
can occur in any order and the type, dimensions and equivalences of items
in common may not be known until that stage.
~BFor each common block a COMMON.LIST of all items in COMMON
statements of that named block is created. This list is used in declaring
the items in section 6.
~S1~O3.1.6 EQUIVALENCE()
~BThis processes the EQUIVALENCE statement. Each item in an equivalence
n-list is checked to ensure that it is not the name of the enclosing
sub-program, an external item an intrinsic item, a constant parameter
or a dummy argument.
Then an equivalence entry (described in section 6) is
allocated and initialised.
As with items in common,
further errors for equivalencing must be handled in section 6.
~BSubscripts and substrings that occur in equivalence items are processed
by EVAL.CONST.EXPR() from section 11. Any errors in these expressions are detect
ed
by that routine. The resulting valid subscript or substring values are
stored in the equivalence entry for checking in section 6. The only
substring and subscript faults that can be detected at this stage are
more than seven subscripts and a substring lower bound which is less
than one.
~S1~O3.1.7 PARAMETER()
~BThis processes the PARAMETER statement. Each name in the parameter list
is checked to ensure that it has not already been defined as a parameter,
or has nor been saved, or is an intrinsic, or external, or has been
equivalenced, or used in common. If the name is a valid one the constant
expression which gives the value to the parameter is evaluated to the
type of the name using EVAL.CONST.EXPR. If the parameter is of type CHARACTER
and its length is of assumed size
then its length in the property table is
updated. The value of the parameter is also copied from the
LINE.SPACE to the LOCAL.SPACE, for character items when the
constant in the LOCAL.SPACE is not the same size
as the item, on copying the character constant it is
truncated or space filled as necessary.~
~S1~O3.1.8 SAVE()
~BThe SAVE statement is processed by this routine. The statement may
have a list of common block and variable names, or may have an empty
list. If the list is empty and the statement occurred in the main
program unit then no action is taken. If the empty list occurred in
another subprogram unit then all variables used in that unit must be
identified and marked as saved.
~BWhen the list of items is present, each item is checked. If it is a
common block name the common block properties are updated.
Any name other than a common block name
is checked to ensure that it is not an intrinsic name, an external,
a variable in common, a dummy argument, a parameter name or has been
previously saved. If it is a valid name it is marked as saved in the
property table.
~S1~O3.1.9 IMPLICIT()
~BThis processes the IMPLICIT statement. The information from this
statement changes or confirms the entries in the implicit typing
table.
~BFirst the type of entry is accepted, and if it was character
the optional length is input by GETLENGTH. The first letter is
accepted followed by the second if it was present. If two letters
were specified they are checked to ensure alphabetic ordering (those
out of order are swapped). The implicit table is updated with the
type information for the specified letters or range of letters, if
the data has not already been specified in this program unit.
~S1~O3.1.10 DECL ARRAY()
~BThis routine is used by the semantics for several of the declaration
statements, and processes an array declarer, if present. The first check
performed is for an item that has previously been dimensioned. Each upper
and lower bound is processed by EVAL.CONST.EXPR if it is not an assumed size
or dummy argument array.
If the lower bound is absent a one is assumed. The
two bounds are then checked to ensure the lower is less than the upper.
This is done for each dimension, checking that there are not too many
dimensions. The routine indicates if a valid or invalid declarer was processed.
~BFor each statement that has an adjustable array declarer
the analysis record for the statement is saved in the LOCAL.SPACE
for evaluation of the adjustable bounds in section 6.
~S1~O3.1.11 GET.LENGTH(EXPR.INDEX,DEFAULT)LENGTH
~BThis routine is used when the length of a character type needs to be
processed. It uses EVAL.CONST.EXPR to evaluate the constant expression, and chec
ks
the result to ensure it is greater than zero. The routine returns the
length specified or a default length if there was no length, or an
invalid one.
~S1~O3.2 Data Structures
~BALL.SAVE.G
A value of one means all items within the program unit are to be
saved.~
~Y
~V9 -1
~P
~D15
~HFLOWCHARTS
~
~
~H                FTN051
~V9 -1
~F
@TITLE FTN05(1,11)
@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
24-DEC-82 (BCT) First release of this section
SPECIFICATION STATEMENT
PROCESSING SECTION
@BOX 2.0
[IMPORTS FTN5/1]
MODULE HEADING
@BOX 4.0
LITERAL DECLARATIONS
@BOX 5.0
SCALAR DECLARATIONS
@BOX 7.0
PROCEDURES IN MODULE
   TYPE :5.1:
   DIMENSION :5.2:
   EXTERNAL :5.3:
   INTRINSIC :5.4:
   COMMON :5.5:
   EQUIVALENCE :5.6:
   PARAMETER :5.7:
   SAVE :5.8:
   IMPLICIT :5.9:
   DECLARRAY :5.10:
   GET.LENGTH:5.11:
   SAVE.DATA :5.12:
   SAVE.PROPS :5.13:
   SCAN.EXPR :5.14:
   SAVE.CONST :5.15:
@BOX 9.0
END
@BOX 2.1
#FTN05/1
;MODULE (F.TYPE,DIMENSION,EXTERNAL,INTRINSIC,COMMON,
   EQUIVALENCE,PARAMETER,SAVE,IMPLICIT,GET.LENGTH,
   ALL.SAVE.G,AMBIG.PARAM.G,
   DATA.LIST.ROOT,SAVE.PROPS,PROPS.T.DUMP.G); :: @@@ BCT 24-DEC-82
@BOX 4.1
;LITERAL INVALID.L = 0,VALID.L = 1
;LITERAL/ADDR CONST.PROP NIL.CONST =
;LITERAL/ADDR [PROPS] NIL.PROPS =  :: @@@ BCT 24-DEC-82
;LITERAL/ADDR [$IN] NIL.AS =
@BOX 5.1
; *GLOBAL 2
;$IN ALL.SAVE.G, AMBIG.PARAM.G :: @@@ BCT 24-DEC-82
; ADDR DATA.LIST DATA.LIST.ROOT :: @@@ BCT 24-DEC-82
;ADDR [PROPS] PROPS.T.DUMP.G
;ADDR [$IN] AS.DUMP.G
; *GLOBAL 0
@BOX 7.1
;P.SPEC F.TYPE()
;P.SPEC DIMENSION()
;P.SPEC EXTERNAL()
;P.SPEC INTRINSIC()
;P.SPEC COMMON()
;P.SPEC EQUIVALENCE()
;P.SPEC PARAMETER()
;P.SPEC SAVE()
;P.SPEC IMPLICIT()
;P.SPEC GET.LENGTH($IN,$IN)/$IN
:: @@@ BCT 24-DEC-82 Start of changes
;P.SPEC DECL.ARRAY(ADDR LOCAL.PROP,$IN)/$IN
;P.SPEC SAVE.DATA($IN,$IN)
;P.SPEC SAVE.PROPS()/ADDR [PROPS]
;P.SPEC SCAN.EXPR($IN)
;P.SPEC SAVE.CONST($IN,$IN)
:: @@@ BCT 24-DEC-82 End of changes
#FTN05.1
#FTN05.2
#FTN05.3
#FTN05.4
#FTN05.5
#FTN05.6
#FTN05.7
#FTN05.8
#FTN05.9
#FTN05.10
#FTN05.11
#FTN05.12
#FTN05.13
#FTN05.14
#FTN05.15
@BOX 9.1
;*END
@END
@TITLE FTN05/1(1,11)
@COL 1S-2R-3R
@COL 4R-5R-6R-7F
@FLOW 1-2-3-4-5-6-7
@ROW 2-4
@BOX 1.0
SPECIFICATION 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
;TYPE PROPS;
;TYPE CONST.PROP;
;TYPE LOCAL.PROP;
;TYPE EQUIV.PROP IS
      ADDR EQUIV.PROP GR.LINK,IGR.LINK
      ADDR LOCAL.PROP EQ.LP.A
      $IN EQ.NO.DIM,EQ.L.SS,EQ.U.SS
      ADDR [$IN] EQ.SUBS
      $LO8 EQ.FLAG
;TYPE NAME.T IS $AD[$LO8] NAME :: ??? JM 29-DEC-82
;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
;TYPE DATA.LIST IS
   ADDR [$IN] ARP
   ADDR [PROPS] PROPS.P
   ADDR DATA.LIST NEXT;  :: @@@ BCT 24-DEC-82
@BOX 3.1
;IMPORT LITERAL MAX.SUBS.L,AS.Z.L,PROPS.Z.L,ST.CH.Z.L,
        LOCAL.SPACE,ACC.Z.Z.L,LINE.SZ.L
;IMPORT LITERAL $LO8 SPACE.L
@BOX 4.1
;ADDR LOCAL.PROP F.L.PROP.G,LOCAL.LIST.HD.G
;ADDR COMMON.PROP F.C.PROP.G,BLANK.COM.G,COM.LIST.G
;$IN STAT.AP.G,END.AP.G,PROPS.I
; $LO8 PU.G
@BOX 5.1
; $LO8 [26] IMPLICIT.G
; $LO8 [ST.CH.Z.L] ST.CH
; $IN [26] IMPLICIT.LEN.G
; $IN[AS.Z.L] AS
; PROPS[PROPS.Z.L] PROPS.T
; $LO8 [ACC.Z.Z.L] ACC.Z.G :: @@@ BCT 24-DEC-82
@BOX 6.1
;P.SPEC EVAL.CONST.EXPR($IN,$IN)/ADDR CONST.PROP
;P.SPEC CHECK.EXPR($IN)/$IN
;P.SPEC COPY.CONST(ADDR CONST.PROP,$IN)/ADDR CONST.PROP
;P.SPEC ADD.G.NAME(ADDR NAME.T)/ADDR GLOBAL.PROP
;P.SPEC ADD.C.NAME(ADDR NAME.T,$IN)/ADDR COMMON.PROP
; P.SPEC LOOK.UP.INTRINSIC(ADDR LOCAL.PROP)/$IN
;P.SPEC FAULT($IN,$IN)
;P.SPEC MAKE.EQUIV.PROP($IN)/ADDR EQUIV.PROP
;P.SPEC MAKE.IN($IN,$IN)/ADDR [$IN]
;P.SPEC MAKE.LO8($IN,$IN)/ADDR [$LO8]
;P.SPEC MAKE.PROPS($IN,$IN)/ADDR [PROPS]
;P.SPEC MAKE.DATA.LIST($IN)/ADDR DATA.LIST
@END
@TITLE FTN05.1(1,11)
@COL 1S-3R-4T-5T-6T-8T-9T-10R-11T-12F
@COL 16R-14R-17R-18R
@ROW 5-16
@FLOW 1-3-4NO-5NO-6NO-8NO-9NO-10-11NO(END OF TYPELIST)-12
@FLOW 5YES-14-18-11YES-4YES-16-18
@FLOW 6YES-17-18
@FLOW 8YES-10
@FLOW 9YES-11
@BOX 1.0
TYPEST
@BOX 3.0
OBTAIN TYPE
IF CHARACTER,GET LENGTH => DEFAULT :5.11:
SET PTR TO FIRST ITEM FROM A/R
@BOX 4.0
OBTAIN PROP PTR OF VAR
IS IT THE ENCLOSING PROGRAM,
BLOCK DATA OR SUBROUTINE NAME?
@BOX 5.0
IS IT ALREADY TYPED?
@BOX 6.0
IS IT A CONSTANT NAME?
@BOX 8.0
NO ARRAY DECLARER?
@BOX 9.0
PROCESS ARRAY DECL :5.10:
INVALID ?
@BOX 10.0
IF CHARACTER,GET LENGTH => PROPS :5.11:
ADD TYPE INTO PROPS
@BOX 11.0
SAVE DATA CLIST IF PRESENT
OBTAIN PTR TO NEXT ITEM
MORE IN LIST?
@BOX 12.0
END
@BOX 14.0
SET UP WARNING 147
'% IS ALREADY TYPED'
@BOX 16.0
SET UP WARNING 146
'THE ENCLOSING SUBPROGRAM NAME
% SHOULD NOT BE USED'
@BOX 17.0
SET UP WARNING 148
'% IS A CONSTANT'
@BOX 18.0
ISSUE WARNING
FAULT
@BOX 1.1
;PROC F.TYPE
;$IN TYP, F
;$IN DEFAULT,AP1,AP2,LS
;ADDR LOCAL.PROP PROP.PTR
;1 => DEFAULT
@BOX 3.1
;NIL.PROPS => PROPS.T.DUMP.G :: @@@ BCT 24-DEC-82
;NIL.AS => AS.DUMP.G :: @@@ BCT 24-DEC-82
;AS[STAT.AP.G=>AP1]=>TYP
:: @@@ BCT 24-DEC-82 start of new code
; 1+> AP1
;(IF TYP = 5 THEN
     GET.LENGTH(AP1,DEFAULT)
 ELSE AS[AP1]) => DEFAULT
;IF TYP /= 5 THEN IF DEFAULT < 0 THEN
     ACC.Z.G [TYP] => DEFAULT
 ELSE FAULT (149,6) FI FI
IF TYP = 0 AND DEFAULT = 3 THEN
   1 => TYP FI
:: @@@ BCT 24-DEC-82 end of new code
;AS[1+>AP1]=>AP2
@BOX 4.1
;LOC OF PROPS.T[AS[AP2+1]]=>PROP.PTR => F.L.PROP.G
;IF L.SPECS OF PROP.PTR^=>LS&%800/=0 AND L.KIND OF PROP.PTR^ /= 6
@BOX 16.1
;146 => F :: @@@ BCT 24-DEC-82
@BOX 5.1
;IF LS & %80 /= 0
@BOX 6.1
;IF LS & %40 /= 0
@BOX 8.1
;IF AS[AP2] /= 1
@BOX 9.1
:: @@@ BCT 24-DEC-82
;IF DECL.ARRAY(PROP.PTR,AP2+1) =INVALID.L
@BOX 10.1
;IF TYP = 5 THEN
     ;GET.LENGTH(1 + AP1,DEFAULT) => L.LEN OF PROP.PTR^
 ELSE DEFAULT => L.LEN OF PROP.PTR^ :: @@@ BCT 24-DEC-82
 FI
;TYP => L.TYPE OF PROP.PTR^
@BOX 11.1
;%80 !> L.SPECS OF PROP.PTR^
;IF TYP = 5 THEN
   ;1+>AP1
;FI
;SAVE.DATA(AS[AP2+1],AS[1+>AP1]) :: @@@ BCT 24-DEC-82
;IF AS [1 +> AP1] => AP2 /= -1
@BOX 12.1
END
@BOX 14.1
;147 => F :: @@@ BCT 24-DEC-82
@BOX 17.1
;148 => F :: @@@ BCT 24-DEC-82
@BOX 18.1
;FAULT(F, 1)
@END
@TITLE FTN05.2(1,11)
@COL 1S-3R-4T-6R-7T-8F
@COL 9R
@ROW 6-9
@FLOW 1-3-4NO-6-7NO(END OF DIM LIST)-8
@FLOW 4YES(FN,SUBR,EXT)-9-7YES-4
@BOX 1.0
DIMENSION
@BOX 3.0
OBTAIN PTR TO FIRST ITEM IN A/R
@BOX 4.0
IS ITEM THE ENCLOSING SUBPROGRAM
OR AN EXTERNAL
OR AN INTRINSIC
OR PREVIOUSLY DIMENSIONED
OR A PARAMETER?
@BOX 6.0
PROCESS ARRAY DECL :5.10:
@BOX 7.0
SAVE DATA CLIST IF PRESENT
ADVANCE PTR TO NEXT ITEM
ANY MORE ITEMS?
@BOX 8.0
END
@BOX 9.0
FAULT 9
'DIMENSION SPECIFIED FOR %'
@BOX 1.1
;PROC DIMENSION
;$IN AP1,AP2
;ADDR LOCAL.PROP PROP.PTR
@BOX 3.1
;NIL.AS => AS.DUMP.G :: @@@ BCT 24-DEC-82
; NIL.PROPS => PROPS.T.DUMP.G :: @@@ BCT 24-DEC-82
;AS[STAT.AP.G => AP1] => AP2
@BOX 4.1
;LOC OF PROPS.T[AS[AP2]] => PROP.PTR
;PROP.PTR => F.L.PROP.G :: @@@ BCT 24-DEC-82
;IF L.SPECS OF PROP.PTR^ &%846 /= 0
     OR L.KIND OF PROP.PTR^ /= 0
@BOX 9.1
;FAULT(9,1)
@BOX 6.1
;DECL.ARRAY(PROP.PTR,AP2) :: @@@ BCT 24-DEC-82
@BOX 7.1
;SAVE.DATA (AS[AP2],AS[1+>AP1]) :: @@@ BCT 24-DEC-82
;IF AS[1+>AP1] => AP2 /= -1
@BOX 8.1
END
@END
@TITLE FTN05.3(1,10)
@COL 1S-3R-4T-7R-8T-9F
@COL 10R
@ROW 7-10
@FLOW 1-3-4NO-7-8NO(END OF EXT LISTS)-9
@FLOW 8YES-4YES-10-8
@BOX 1.0
EXTERNAL
@BOX 3.0
OBTAIN PTR TO FIRST ITEM IN A/R
@BOX 4.0
IS ITEM AN ARRAY
OR SAVED
OR PARAMETER
OR EQUIVALENCED
OR IN COMMON
OR INTRINSIC
OR DIMENSION
OR ENCLOSING SUBPROGRAM
OR IN PREV EXTERNAL ?
@BOX 7.0
MARK AS SUBPROGRAM
IN PROPS
UPDATE ITEM PROPS
@BOX 8.0
ADVANCE PTR TO NEXT ITEM
ANYMORE ITEMS?
@BOX 9.0
END
@BOX 10.0
FAULT 10
'INVALID EXTERNAL ITEM %'
@BOX 1.1
;PROC EXTERNAL
;LITERAL/ADDR[$LO8]NIL.STR =
;$IN AP1
;ADDR LOCAL.PROP PROP.PTR
@BOX 3.1
;STAT.AP.G => AP1
@BOX 4.1
;LOC OF PROPS.T[AS[AP1]] => PROP.PTR
;IF L.SPECS OF PROP.PTR^ & %85F /= 0 OR
     L.KIND OF PROP.PTR^ = 2
@BOX 10.1
;PROP.PTR => F.L.PROP.G
;FAULT(10,1)
@BOX 7.1
;NIL.STR => L.ARG.SPEC.P OF LALT OF PROP.PTR^
;8 => L.KIND OF PROP.PTR^
; 2 !> L.SPECS OF PROP.PTR^
@BOX 8.1
;IF AS[1+>AP1]    /= -1
@BOX 9.1
END
@END

@TITLE FTN05.4(1,10)
@COL 2S-3R-4T-5R-6T-7F
@COL 9R
@ROW 5-9
@FLOW 2-3-4N-5-6N-7
@FLOW 4Y-9-6Y-4
@BOX 2.0
INTRINSIC
@BOX 3.0
OBTAIN PTR TO FIRST ITEM IN A/R
@BOX 4.0
IS ITEM A PARAMETER
OR SAVED
OR IN EXTERNAL
OR IN COMMON
OR IN EQUIVALENCE
OR PREV INTRINSIC
OR DUMMY ARGUMENT
OR ENCLOSING SUBPROGRAM
OR NAME NOT IN LIBRARY?
@BOX 5.0
ADD INTRINSIC PROPERTIES
UPDATE ITEM PROPS
@BOX 6.0
ADVANCE PTR
ANY MORE IN LIST?
@BOX 7.0
END
@BOX 9.0
FAULT 11
'INVALID INTRINSIC ITEM %'
@BOX 2.1
;PROC INTRINSIC
;$IN AP1,AP2,I
;ADDR LOCAL.PROP PROP.PTR

@BOX 3.1
;AS[STAT.AP.G => AP1] => AP2
@BOX 4.1
;LOC OF PROPS.T[AP2] => PROP.PTR
;IF L.SPECS OF PROP.PTR^ & %A5F /= 0 OR
     L.KIND OF PROP.PTR^ /= 0
     OR LOOK.UP.INTRINSIC(PROP.PTR) => I < 0
@BOX 9.1
;PROP.PTR => F.L.PROP.G
;FAULT(11,1)
@BOX 5.1
;I => L.INTR.NO OF L.ALT OF PROP.PTR^
;7 => L.KIND OF PROP.PTR^
;0=>L.SPEC.TL.NAME OF L.ALT OF PROP.PTR^
; 4!> L.SPECS OF PROP.PTR^
@BOX 6.1
;IF AS[1 +> AP1] => AP2 /= -1
@BOX 7.1
END
@END


@TITLE FTN05.5(1,11)
@COL 2S-19R-3R-9R-27T-4T-7T-8T-10T-11R-12R-13N-14T-15T-16F
@COL 24T-25R-26R-17R-22R-23N
@ROW 3-24
@ROW 7-17
@ROW 11-22
@ROW 13-23
@FLOW 2-19-3-9-27NO-4NO-7NO-8NO-10NO-11-12-13-14NO-15NO-16
@FLOW 27Y-24N-25-26-4
@FLOW 24Y-26
@FLOW 4YES-17-23-13
@FLOW 7YES-10YES-22-12
@FLOW 8YES-23
@FLOW 14YES-4
@FLOW 15YES-3
@BOX 2.0
COMMON
@BOX 19.0
OBTAIN A/R PTR TO FIRST COMMON
@BOX 3.0
OBTAIN A/R PTR TO FIRST ITEM IN
THIS COMMON
@BOX 9.0
SET COMMON PROPERTIES
@BOX 4.0
IS ITEM THE ENCLOSING SUBPROGRAM
OR EXTERNAL
OR INTRINSIC
OR PARAMETER
OR IN SAVE
OR DUMMY ARGUMENT
OR IN PREV COMMON?
@BOX 7.0
NO ARRAY DECLARATOR?
@BOX 8.0
PROCESS ARRAY DECL :5.10:
INVALID?
@BOX 10.0
HAS THIS COMMON BEEN
USED IN THIS PU?
@BOX 11.0
SET COMMON LIST HD
@BOX 12.0
SET COMMON LIST TAIL
UPDATE ITEM PROPS
@BOX 14.0
ADVANCE PTR TO NEXT ITEM
IN THIS COMMON
ANY MORE IN THIS COMMON?
@BOX 15.0
ANY MORE COMMONS?
@BOX 16.0
END
@BOX 17.0
FAULT 12
'INVALID COMMON ITEM %'
@BOX 22.0
LINK LAST ITEM IN COMMON
TO THIS ONE
@BOX 27.0
IN BLOCK DATA?
@BOX 24.0
COMMON NOT IN A PREVIOUS
BLOCK DATA?
@BOX 25.0
FAULT
COMMON name IN A
PREVIOUS BLOCK DATA
SUBPROGRAM
@BOX 26.0
SET BLOCK DATA USE
BITS IN PROPS
@BOX 2.1
;PROC COMMON
;$IN AP1,AP2
;ADDR LOCAL.PROP PROP.PTR,LPF,LPB
;LITERAL/ADDR LOCAL.PROP L.P.NIL =
;ADDR COMMON.PROP GL.PTR
;$IN AP3,BC
@BOX 19.1
;NIL.PROPS => PROPS.T.DUMP.G
;NIL.AS => AS.DUMP.G :: @@@ BCT 27-DEC-82
;STAT.AP.G => AP1
@BOX 3.1
;AS[AP1+1] => AP2
@BOX 9.1
;IF AS[AP1] = 0 THEN BLANK.COM.G => GL.PTR ; %1000 => BC
ELSE COM OF PROPS.T[AS[AP1]] => GL.PTR ; 0 => BC FI
;%10!> C.KIND OF GL.PTR^
@BOX 4.1
;LOC OF PROPS.T[AS[AS[AP2] => AP3 + 1]] => PROP.PTR
;IF L.SPECS OF PROP.PTR^ & %A57 /= 0
OR L.KIND OF PROP.PTR^ > 2
@BOX 7.1
;IF AS[AP3] = 0
@BOX 8.1
:: @@@ BCT 27-DEC-82
;IF DECL.ARRAY(PROP.PTR,AP3+1) = INVALID.L
@BOX 10.1
;L.LINK1 OF PROP.PTR^ => LPF
;L.LINK2 OF PROP.PTR^ => LPB
;IF LPF /= LP.NIL THEN
     ;LPB => L.LINK.2 OF LPF^
;ELSE
     ;LPB => LOCAL.LIST.HD.G
;FI
;IF LPB /= LP.NIL THEN
     ;LPF => L.LINK1 OF LPB^
;FI
;IF C.TAIL OF GL.PTR^ /= L.P.NIL
@BOX 11.1
;PROP.PTR => C.HEAD OF GL.PTR^
;COM.LIST.G => C.PREV.P OF GL.PTR^
;GL.PTR => COM.LIST.G
@BOX 12.1
;L.P.NIL => L.LINK1 OF PROP.PTR^
;PROP.PTR => C.TAIL OF GL.PTR^
; %10  !BC !> L.SPECS OF PROP.PTR^
@BOX 14.1
;IF AS[1+>AP2] /= -1
@BOX 15.1
;IF AS[2+>AP1] /= 2
@BOX 16.1
END
@BOX 17.1
;PROP.PTR => F.L.PROP.G
;FAULT(12,1)
@BOX 22.1
;PROP.PTR => L.LINK1 OF C.TAIL^ OF GL.PTR^
@BOX 27.1
;IF PU.G = 1
@BOX 24.1
;IF C.KIND OF GL.PTR^ & %40 = 0
    OR C.TAIL OF GL.PTR^ /= L.P.NIL
@BOX 25.1
;GL.PTR=>F.C.PROP.G
;FAULT(124,2)
@BOX 26.1
;%C0 !> C.KIND OF GL.PTR^
@END
@TITLE FTN05.6(1,10)
@COL 2S-23R-3R-9T-5R-7R-8R-11T-24R-12R-14N-15T-17T-18F
@COL 19R-22R-29N
@ROW 5-19
@ROW 24-22
@ROW 14-29
@FLOW 2-23R-3-9NO-5-7-8-11NO-24-12-14-15NO-17NO-18
@FLOW 9YES-19-29-14
@FLOW 11YES-22-12
@FLOW 17YES-3
@FLOW 15YES-9
@BOX 2.0
EQUIVALENCE
@BOX 23.0
OBTAIN FIRST EQ LIST FROM A/R
@BOX 3.0
SET PTRS UP FOR CIRC LIST OF EQUIV
THIS GROUP
@BOX 5.0
OBTAIN NEXT ITEM FROM EQ LIST IN A/R
INIT EQ TBL ENTRY
@BOX 7.0
PROCESS SUBSCRIPTS :5.6.1:
@BOX 8.0
PROCESS SUBSTRING :5.6.2:
@BOX 9.0
IS ITEM THE ENCLOSING SUBPROGRAM
OR EXTERNAL
OR INTRINSIC
OR DUMMY ARG
OR PARAMETER?
@BOX 11.0
ITEM PREV EQUIV?
@BOX 24.0
LINK INTER GROUP LIST
TO ITSELF
@BOX 12.0
ADD TO GROUP EQUIV LIST
UPDATE ITEM PROPS
@BOX 15.0
ADVANCE TO NEXT ITEM IN EQ LIST IN A/R
ANY MORE ITEMS?
@BOX 17.0
ADVANCE TO NEXT EQUIV LIST
ANY MORE EQUIV LISTS?
@BOX 18.0
END
@BOX 19.0
FAULT 14
'INVALID EQUIVALENCE ITEM %'
@BOX 22.0
ADD TO INTER GROUP CIRC LIST
@BOX 2.1
;PROC EQUIVALENCE
;ADDR[$IN] SS
;LITERAL/ADDR [$IN] NIL.I=
;$IN AP1,AP2,AP3,SUB.CNT,Z
;ADDR LOCAL.PROP PROP.PTR
; ADDR CONST.PROP CONST.PTR
;ADDR EQUIV.PROP EQ.T, EQ.RING,IGR.E
;LITERAL/ADDR EQUIV.PROP EQ.NIL =
@BOX 23.1
;AS[STAT.AP.G => AP1] => AP2
@BOX 3.1
;EQ.NIL => EQ.RING
@BOX 9.1
;LOC OF PROPS.T[AS[AP2]] => PROP.PTR
;IF L.SPECS OF PROP.PTR^ & %A46 /= 0 OR
     L.KIND OF PROP.PTR^ > 2
@BOX 5.1
;MAKE.EQUIV.PROP(LOCAL.SPACE) => EQ.T
;PROP.PTR => EQ.LP.A OF EQ.T^
;0 => EQ.NO.DIM OF EQ.T^ => EQ.FLAG OF EQ.T^
    => EQ.L.SS OF EQ.T^ => EQ.U.SS OF EQ.T^
;NIL.I => EQ.SUBS OF EQ.T^
@BOX 7.1
#FTN05.6.1
@BOX 8.1
#FTN05.6.2
@BOX 11.1
;IF L.SPECS OF PROP.PTR^ & 8 /= 0
@BOX 24.1
;EQ.T => L.EQT.P OF LALT OF PROP.PTR^ => IGR.LINK OF EQ.T^
@BOX 12.1
;IF EQ.RING = EQ.NIL THEN
     EQ.T => GR.LINK OF EQ.T^ => EQ.RING
ELSE
     GR.LINK OF EQ.RING^ => GR.LINK OF EQ.T^
     ;EQ.T => GR.LINK OF EQ.RING^
FI
; 8 !> L.SPECS OF PROP.PTR^
@BOX 15.1
;IF AS[3+>AP2] /= -1
@BOX 17.1
;IF AS[1+>AP1] => AP2 /= -1
@BOX 18.1
END
@BOX 19.1
;PROP.PTR => F.L.PROP.G
;FAULT(14,1)
@BOX 22.1
;L.EQT.P OF LALT OF PROP.PTR^ => I.GR.E
;IGR.LINK OF I.GR.E^ => I.GR.LINK OF EQ.T^
;EQ.T => IGR.LINK OF I.GR.E^
@END
@TITLE FTN05.6.1(1,10)
@COL 1S-3R-11T-12R-4T-5R-8T-14R-9F
@COL 10R
@ROW 5-10
@FLOW 1-3-11N-12-4NO-5-8YES(MORE SUBS)-4YES(TOO MANY SUBSCRIPTS)-10-8NO-14-9
@FLOW 11Y-9
@BOX 1.0
PROCESS SUBSCRIPT
@BOX 3.0
INIT SUBSCRIPT CNT
SET PTR TO FIRST SUBSCRIPT
@BOX 11.0
SUBSCRIPTS ABSENT?
@BOX 12.0
MAKE SUBSCRIPT ARRAY
@BOX 4.0
TOO MANY SUBSCRIPTS?
@BOX 5.0
CODE EXPRESSION(INTEGER,CONSTANT)
STORE SUBSCRIPT IN EQTABLE
@BOX 8.0
ANYMORE SUBSCRIPTS?
@BOX 14.0
STORE NO OF SUBSCRIPTS
IN EQTBL
@BOX 9.0
END
@BOX 10.0
FAULT 15
'% HAS MORE THAN 7 SUBSCRIPTS'
@BOX 1.1
@BOX 3.1
; 0 => SUB.CNT
;AS[AP2+1] => AP3
@BOX 11.1
;IF AP3 = 0
@BOX 12.1
;AS[AP3]=>Z
;MAKE.IN(7,LOCAL.SPACE) => EQ.SUBS OF EQ.T^ => SS
@BOX 4.1
;IF  SUB.CNT >= MAX.SUBS.L
@BOX 5.1
;EVAL.CONST.EXPR(AS[1+>AP3],%B) => CONST.PTR
;IF CONST.PTR /= NIL.CONST THEN
     ; INT.CONST OF CONST.PTR^ => SS^[SUB.CNT]
ELSE
     ;1 => SS^[SUB.CNT]
 FI
@BOX 8.1
;IF 1+>SUB.CNT < Z
@BOX 14.1
;SUB.CNT => EQ.NO.DIM OF EQ.T^
@BOX 10.1
;PROP.PTR => F.L.PROP.G
;FAULT(15,1)
@END
@TITLE FTN05.6.2(1,10)
@COL 1S-3T-5T-6T-13T-11R-8T-9T-12F
@COL 7R-10R
@ROW 6-7
@ROW 9-10
@FLOW 1-3Y-12
@FLOW 3N-5N-6-13N-11
@FLOW 5Y-7-8Y-10-12
@FLOW 13Y-8
@FLOW 6Y-7
@FLOW 9Y-10
@FLOW 8N-9N-12
@FLOW 11-7
@BOX 1.0
PROCESS SUBSTRING
@BOX 3.0
SUBSTRING ABSENT?
@BOX 4.0
END
@BOX 5.0
LOWER BOUND ABS?
@BOX 6.0
CODE EXPRESSION(INTEGER,CONSTANT) => LOWER
EXPRESSION INVALID?
@BOX 7.0
1 => LOWER
@BOX 13.0
LOWER >= 1
@BOX 11.0
FAULT 16
'% HAS LOWER SUBSTRING BOUND BELOW 1'
@BOX 8.0
UPPER BOUND ABS?
@BOX 9.0
CODE EXPRESSION(INTEGER,CONSTANT)
INVALID?
@BOX 10.0
LENGTH OF STRING => UPPER
@BOX 12.0
END
@BOX 1.1
@BOX 3.1
;IF AS[AP2+2] => AP3 = 0
@BOX 5.1
;IF AS[AP3] = 0
@BOX 6.1
;IF EVAL.CONST.EXPR(AS[AP3],%B) => CONST.PTR = NIL.CONST
@BOX 13.1
; IF INT.CONST OF CONST.PTR^ => EQ.L.SS OF EQ.T^ >= 1
@BOX 11.1
;PROP.PTR => F.L.PROP.G
;FAULT(16,1)
@BOX 8.1
;IF AS[AP3+1] = 0
@BOX 9.1
; IF EVAL.CONST.EXPR(AS[AP3+1],%B) => CONST.PTR /= NIL.CONST THEN
     ; INT.CONST OF CONST.PTR^ => EQ.U.SS OF EQ.T^
  FI
;IF CONST.PTR = NIL.CONST
@BOX 10.1
;L.LEN OF PROP.PTR^ => EQ.U.SS OF EQ.T^
@BOX 7.1
;1 => EQ.L.SS OF EQ.T^
@BOX 12.1
@END

@TITLE FTN05.7(1,11)
@COL 1S-3R-4T-20N-6T-8T-11R-10T-12R-9R
@COL 5F-7R-13R-14T-15R-16R-17R
@ROW 20-5
@ROW 6-7
@FLOW 1-3-4N-20-6N-8N-11-10N-12-9-4Y-5
@FLOW 8Y-9
@FLOW 10Y-13-14N-15-16-17-12
@FLOW 14Y-16
@FLOW 6Y-7-9
@BOX 1.0
PARAMETER
@BOX 3.0
NOTE KIND OF PARAMETER STATEMENT
OBTAIN PTR TO FIRST ITEM
@BOX 4.0
ALL ITEMS PROCESSED?
@BOX 5.0
END
@BOX 6.0
GET NAME OF PARAMETER
USED IN COMMON,
EQUIVALENCE,
EXTERNAL,
INTRINSIC,
SAVE,
DUMMY ARGUMENT,
ENCLOSING SUBPROGRAM,
OR PREVIOUS PARAMETER?
@BOX 7.0
FAULT
'INVALID PARAMETER ITEM @'
@BOX 8.0
GET TYPE OF NAME
CODE CONSTANT
EXPRESSION(TYPE,CONSTANT) => VALUE:11.7:
FAULTY?
@BOX 10.0
CHARACTER ITEM?
@BOX 11.0
CREATE A COPY OF CONSTANT
IN LOCAL SPACE :11.8:
@BOX 12.0
UPDATE PROPS
@BOX 13.0
OBTAIN LENGTH OF CONSTANT
@BOX 14.0
ITEM NOT ASSUMED SIZE
@BOX 15.0
SET ITEM LENGTH IN PROPS
@BOX 16.0
CREATE CHAR CONST IN LOCAL
SPACE OF ITEM SIZE
@BOX 17.0
COPY CONSTANT TO IT
TRUNCATE OR SPACEFILL AS NECESSARY
@BOX 9.0
ADVANCE PTR
@BOX 1.1
;PROC PARAMETER
;ADDR LOCAL.PROP PROP.PTR
;$IN AP1,CH,AP2,L,IL,I,KIND,AP3 :: @@@ BCT 24-DEC-82
;$LO8 TEMP.TYP ; :: @@@ BCT 24-DEC-82
;ADDR CONST.PROP C.PROP
; ADDR [$LO8] STR,STR1
;LITERAL/ ADDR COMMON.PROP C.NIL =
@BOX 3.1
;AS[STAT.AP.G => AP1] => KIND :: @@@ BCT 24-DEC-82
;AS[1+>AP1] => AP2 :: @@@ BCT 24-DEC-82
;IF KIND /= 0 THEN FAULT(150,6) FI :: @@@ BCT 24-DEC-82
@BOX 4.1
;IF AP2 = -1
@BOX 5.1
; KIND *> AMBIG.PARAM.G :: @@@ BCT 24-DEC-82
END
@BOX 6.1
; 1+> AMBIG.PARAM.G :: @@@ BCT 24-DEC-82
;LOC OF PROPS.T[AS[AP2]] => PROP.PTR
;IF L.SPECS OF PROP.PTR^ & %A5F /= 0 OR
     L.KIND OF PROP.PTR^ /= 0
     OR ADD.C.NAME(^L.NAME OF PROP.PTR^,1) /= C.NIL
@BOX 7.1
;PROP.PTR => F.L.PROP.G
;FAULT(17,1)
@BOX 8.1
:: @@@ BCT 24-DEC-82 start of changes
; IF L.SPECS OF PROP.PTR^ = 0 AND L.KIND OF PROP.PTR^ = 0 AND KIND = 1
    THEN %10 => TEMP.TYP ELSE L.TYPE OF PROP.PTR^ => TEMP.TYP FI
; IF EVAL.CONST.EXPR(AS[AP.2+1]=>AP3,TEMP.TYP) => C.PROP = NIL.CONST
@BOX 10.1
; IF TEMP.TYP = %10 THEN
   AS[AP3] => AP3 ->> 12 & %7 => L.TYPE OF PROP.PTR^
  ;IF AP3 & %1F = %F THEN
     0 => L.LEN OF PROP.PTR^
   ELSE AP3 ->> 5 & %7 => L.LEN OF PROP.PTR^ FI
  FI
:: @@@ BCT 24-DEC-82 end of changes
; IF L.TYPE OF PROP.PTR^ = 5
@BOX 13.1
; -1 => L
; WHILE CH.CONST^[1+>L] OF C.PROP^ /= 0 DO OD
@BOX 14.1
;IF L.LEN OF PROP.PTR^ => IL /= -1
@BOX 15.1
;L=>IL=> L.LEN OF PROP.PTR^
@BOX 16.1
;MAKE.LO8(IL+1,LOCAL.SPACE)=>STR1
@BOX 17.1
;-1=>I
;WHILE 1+>I < IL DO
  ;IF I < L THEN
    ;CH.CONST^[I] OF C.PROP^=>CH
  ;ELSE
    ;SPACE.L=>CH
  ;FI
  ;CH=>STR1^[I]
;OD
;0=>STR1^[I]
;STR1 => CH.CONST OF C.PROP^
@BOX 11.1
;COPY.CONST(C.PROP,1)=>C.PROP
@BOX 12.1
; C.PROP => L.CONST.P OF L.ALT OF PROP.PTR^
; 3 => L.KIND OF PROP.PTR^
@BOX 9.1
; %40 !> L.SPECS OF PROP.PTR^
;AS[1+>AP1] => AP2
@END

@TITLE FTN05.8(1,10)
@COL 1S-3T-8T-9T-10R-12T-13F
@COL 5T-6R-7C-14R-11R
@ROW 9-14
@ROW 10-11
@FLOW 1-3Y-5N-6-7
@FLOW 5Y-7
@FLOW 3N-8N-9N-10-12Y-8Y-14-12
@FLOW 9Y-11-12N-13
@BOX 1.0
SAVE
@BOX 3.0
SET PTR TO 1ST ITEM
EMPTY LIST?
@BOX 5.0
MAIN PROGRAM?
@BOX 6.0
MARK ALL LOCAL VARIABLE AS STATIC
@BOX 7.0
END
@BOX 8.0
COMMON NAME?
@BOX 9.0
INTRINSIC NAME,
EXTERNAL NAME,
VARIABLE IN COMMON,
DUMMY ARGUMENT,
PARAMETER NAME,
ENCLOSING SUBPROGRAM NAME,
PREV SAVE ?
@BOX 10.0
MARK AS STATIC TYPE
@BOX 11.0
FAULT 18
'INVALID ITEM IN SAVE %'
@BOX 12.0
ADVANCE PTR
MORE ITEMS?
@BOX 14.0
MARK AS STATIC COMMON
@BOX 13.0
END
@BOX 1.1
;PROC SAVE
; ADDR COMMON.PROP COM.PTR
;ADDR LOCAL.PROP PROP.PTR
;$IN AP1
@BOX 3.1
;IF AS[STAT.AP.G => AP1] = -1
@BOX 5.1
;IF PU.G = 0
@BOX 6.1
; 1 => ALL.SAVE.G
@BOX 7.1
EXIT
@BOX 8.1
;IF AS[AP1+1] = 1
@BOX 9.1
;LOC OF PROPS.T[AS[AP1]] => PROP.PTR
;IF L.SPECS OF PROP.PTR^ & %A57 /= 0 OR
     ALL.SAVE.G = 1 OR
     L.KIND OF PROP.PTR^ > 4
@BOX 11.1
;PROP.PTR => F.L.PROP.G
;FAULT(18,1)
@BOX 10.1
;1 !> L.SPECS OF PROP.PTR^
@BOX 12.1
;IF AS[2+>AP1] /= -1
@BOX 14.1
; COM OF PROPS.T[AS[AP1]] => COM.PTR
; 1 !> C.KIND OF COM.PTR^
@BOX 13.1
END
@END
@TITLE FTN05.9(1,11)
@COL 1S-3R-4T-13R-6T-7T-8R-10T-12R
@COL 5F
@ROW 13-5
@FLOW 1-3-4N-13-6N-7N-8-10N-12-4Y-5
@FLOW 6Y-10Y-6
@FLOW 7Y-10
@BOX 1.0
IMPLICIT
@BOX 3.0
GET PTR TO FIRST ITEM
@BOX 4.0
FINISHED LIST?
@BOX 5.0
END
@BOX 13.0
GET TYPE
GET LENGTH => LENGTH :5.11:
@BOX 6.0
GET 1ST LETTER
IF 2ND LETTER ABS?
@BOX 7.0
GET 2ND LETTER
ALPHABETIC ORDER?
@BOX 8.0
WARNING
'IMPLICIT LETTERS OUT
OF ORDER
SWAP LETTERS
@BOX 9.0
ALREADY IN TABLE?
@BOX 10.0
PUT IN TABLE
@BOX 11.0
FAULT
@BOX 12.0
ADVANCE PTR
@BOX 1.1
;PROC IMPLICIT
;$IN AP1,AP2
;ADDR LOCAL.PROP PROP.PTR
;$IN CH1,CH2,CH,TYP,LEN
@BOX 3.1
;AS[STAT.AP.G => AP1] => AP2
@BOX 4.1
;IF AP2 = -1
@BOX 5.1
END
@BOX 13.1
;IF AS[AP2] => TYP = 5 THEN
     1 +> AP2
     ;GET.LENGTH(AP2,1) => LEN
:: @@@ BCT 24-DEC-82 Start of new code
 ELSE
     AS[1+>AP2] => LEN
    ;IF LEN >= 0 THEN FAULT(149,6) FI
    ;IF TYP=0 AND LEN=3 THEN 1=>TYP FI
:: @@@ BCT 24-DEC-82 end of new code
FI
; AS[ 1+> AP2] => CH1
@BOX 6.1
;ST.CH[CH1]=>CH1 => CH2
;IF AS[AP2+1] = 0
@BOX 7.1
;ST.CH[AS[AP2+1]] => CH2
;IF CH1 =< CH2
@BOX 8.1
;FAULT(19,1) :: @@@ BCT 24-DEC-82
; CH1 => CH
; CH2 => CH1
; CH => CH2
@BOX 10.1
;WHILE CH2 > = CH1 DO
     TYP => IMPLICIT.G[CH1]
     ;LEN => IMPLICIT.LEN.G[CH1]
     ;1 +> CH1
OD
; IF AS[2 +> AP2] => CH1 /= -1
@BOX 12.1
;AS[1+>AP1] => AP2
@END


@TITLE FTN05.10(1,11)
@COL 2S-15T-3R-4T-5R-7T-8R-9T-10R-11T-12R-13F
@COL 1A-16R-14R-17C
@ROW 3-16
@ROW 5-14
@ROW 13-17
@FLOW 2-15N-3-4NO-5-7NO-8-9Y-11NO-12-13
@FLOW 15Y-16-17
@FLOW 11YES-4YES-14-17
@FLOW 7YES-9
@FLOW 9Y-10-17
@BOX 2.0
PROC DECLARRAY(ARRAY PROP PTR,A/R PTR)
@BOX 15.0
NAME ALREADY DIMENSIONED?
@BOX 16.0
FAULT 20
'% HAS ALREADY BEEN DIMENSIONED'
@BOX 17.0
RESULT = INVALID
@BOX 3.0
INIT SUBSCRIPT COUNT
@BOX 4.0
TOO MANY DIMENSIONS?
@BOX 5.0
OBTAIN PTR TO NEXT DIMENSION
1 => LOWER
PROCESS 1ST BOUND => UPPER :5.10.1:
UPDATE ADJ BOUND INFO
@BOX 7.0
IF 2ND BOUND ABSENT?
@BOX 8.0
UPPER => LOWER
PROCESS 2ND BOUND => UPPER :5.10.1:
UPDATE ADJ BOUND INFO
@BOX 9.0
SAVE ADJ BOUND INFO
LOWER < UPPER
OR ADJUSTABLE DIMENSION
OR ASSUMED SIZE?
@BOX 10.0
FAULT 22
'% HAS THE LOWER BOUND GREATER THAN THE LOWER'
@BOX 11.0
ANY MORE DIMENSIONS?
@BOX 12.0
STORE NO OF DIMS IN ARRAYPROPTBL
COMPLETE PROPS FOR ARRAY
@BOX 13.0
RESULT = VALID
@BOX 14.0
FAULT 21
'% HAS MORE THAN 7 DIMENSIONS'
@BOX 2.1
:: @@@ BCT 24-DEC-82
;PROC DECL.ARRAY(PROP.PTR,AP)
;$IN ADJ.DIM.INFO,SH
;$IN SSC,AI,CA
;$IN[23] ARR.PROP.TBL
;ADDR[$IN] AT
;P.SPEC PROCESS.BOUND()/$IN
#FTN05.10.1
@BOX 15.1
;IF L.KIND OF PROP.PTR^ /= 0
@BOX 16.1
;PROP.PTR => F.L.PROP.G
;FAULT(20,1)
@BOX 17.1
;INVALID.L => DECL.ARRAY
EXIT
@BOX 3.1
;2 => AI
;-1 => SSC
;1 +> AP
;0 => ARR.PROP.TBL[1]
@BOX 4.1
;IF 1+>SSC > 7
@BOX 14.1
;PROP.PTR => F.L.PROP.G
;FAULT(21,1)
@BOX 5.1
;0 => ADJ.DIM.INFO
;1 => ARR.PROP.TBL[AI]
;PROCESS.BOUND() => ARR.PROP.TBL[AI+1]
@BOX 7.1
;IF AS[1+>AP] = 0
@BOX 8.1
;ADJ.DIM.INFO ->> 1 => ADJ.DIM.INFO
;ARR.PROP.TBL[1+AI] => ARR.PROP.TBL[AI]
;PROCESS.BOUND() => ARR.PROP.TBL[1+AI]
@BOX 9.1
;SSC+SSC+2=>SH
;ADJ.DIM.INFO<<-SH !> ARR.PROP.TBL[1]
;IF ARR.PROP.TBL[AI]=< ARR.PROP.TBL[1+AI] OR
   ADJ.DIM.INFO /= 0 AND
   L.SPECS OF PROP.PTR^ & %300 /= 0
@BOX 10.1
;PROP.PTR => F.L.PROP.G
;FAULT(22,1)
@BOX 11.1
;IF ADJ.DIM.INFO = 0 THEN
    ARR.PROP.TBL[AI+1] - ARR.PROP.TBL[AI] +1 => ARR.PROP.TBL[AI+2]
 FI
;3+>AI
;IF AS[1+>AP] /= -1
@BOX 12.1
;MAKE.IN(AI,LOCAL.SPACE) => L.ARR.SPEC.P OF PROP.PTR^ => AT
;WHILE 1->AI >= 0 DO
      ARR.PROP.TBL[AI] => AT^[AI] OD
;SSC+1 => AT^[0]
;2 => L.KIND OF PROP.PTR^
@BOX 13.1
;VALID.L => DECL.ARRAY
END
@END
@TITLE FTN05.10.1(1,11)
@COL 1S-3T-5T-6T-9R-12F
@COL 4R-7R-8R-11R
@ROW 6-7
@ROW 11-9
@FLOW 1-3N-5N-6-9-12
@FLOW 3Y-4-11-12
@FLOW 5Y-7-8-12
@FLOW 6Y-11
@BOX 1.0
PROC PROCESS BOUND
@BOX 3.0
ASSUMED SIZE?
@BOX 4.0
SET ASSUMED SIZE PROP
@BOX 5.0
VARIABLE EXPRESSION?
@BOX 6.0
CODE EXPRESSION(INTEGER,CONSTANT) => VALUE
EXPRESSION INVALID?
@BOX 7.0
SAVE ANALYSIS RECORD FOR LATER CODING
(UNLESS ALREADY SAVED IN THIS STATEMENT)
SET UNKNOWN SIZE PROP
SET ADJUSTABLE BOUND INDICATOR
@BOX 8.0
RESULT = A/R PTR
@BOX 9.0
RESULT = VALUE
@BOX 11.0
RESULT = LOWER BOUND
@BOX 12.0
END
@BOX 12.0
END
@BOX 1.1
;PROC PROCESS.BOUND
;$IN I
; ADDR CONST.PROP CONST.PTR
@BOX 3.1
;IF AS[AP] = 1
@BOX 4.1
;%100 !> L.SPECS OF PROP.PTR^
@BOX 5.1
;IF CHECK.EXPR(AS[AP]) = 1
@BOX 6.1
;IF EVAL.CONST.EXPR(AS[AP],%B) => CONST.PTR = NIL.CONST
@BOX 11.1
;ARR.PROP.TBL[AI] => PROCESS.BOUND
@BOX 12.1
END
@BOX 7.1
; 2 !> ADJ.DIM.INFO
; %8000 !> L.SPECS OF PROP.PTR^
:: @@@ BCT 24-DEC-82 start of changes
; SCAN.EXPR(AS[AP])
;IF AS.DUMP.G = NIL.AS THEN
    ;MAKE.IN(END.AP.G+1,LOCAL.SPACE) => AS.DUMP.G
    ;FOR I<END.AP.G+1 DO AS[I] => AS.DUMP.G^[I] OD
 FI
;AS.DUMP.G => L.AS.DUMP OF LALT OF PROP.PTR^
;SAVE.PROPS() => L.PROPS.T.DUMP OF LALT OF PROP.PTR^
:: @@@ BCT 24-DEC-82 end of changes
@BOX 8.1
;AS[AP] => PROCESS.BOUND
@BOX 9.1
;INT.CONST OF CONST.PTR^ => PROCESS.BOUND
@END

@TITLE FTN05.11(1,10)
@COL 13R-8R
@COL 1S-3T-4T-6T-7R-9T-10R-11R-12F
@COL 5R
@ROW 13-7
@ROW 6-5
@ROW 8-9
@FLOW 1-3N-4N-6N-7-9N-10-11
@FLOW 3Y-8-12
@FLOW 4Y-5-12
@FLOW 6Y-13-9Y-11-12
@BOX 1.0
PROC GET LENGTH(AR.PTR,DEFAULT)
@BOX 3.0
NO LENGTH SPECIFIED?
@BOX 4.0
ASSUMED LENGTH?
@BOX 5.0
RESULT = -1
@BOX 6.0
INTEGER CONSTANT => LENGTH?
@BOX 7.0
CODE EXPRESSION(INTEGER,CONSTANT) => LENGTH
@BOX 8.0
RESULT = DEFAULT
@BOX 9.0
LENGTH > ZERO
@BOX 10.0
FAULT 23
'CHARACTER LENGTH BELOW 1'
1 => LENGTH
@BOX 11.0
RESULT = LENGTH
@BOX 12.0
END
@BOX 13.0
SET LENGTH
@BOX 1.1
;PROC GET.LENGTH(AP,DEFAULT)
;$IN LENGTH
; ADDR CONST.PROP CONST.PTR
@BOX 3.1
;IF AS[AP] = 0
@BOX 8.1
;DEFAULT => GET.LENGTH
@BOX 4.1
;IF AS[AS[AP] => AP] = 0
@BOX 5.1
;-1 => GET.LENGTH
@BOX 6.1
;IF AS[AP] = 1
@BOX 7.1
;IF EVAL.CONST.EXPR(AS[AP+1],%B) => CONST.PTR=NIL.CONST THEN
   DEFAULT => LENGTH
ELSE
   ;INT.CONST OF CONST.PTR^ => LENGTH
FI
@BOX 9.1
;IF LENGTH > 0
@BOX 10.1
;FAULT(23,1)
;1 => LENGTH
@BOX 11.1
;LENGTH => GET.LENGTH
@BOX 12.1
END
@BOX 13.1
;INT OF PROPS.T[AS[AP+1]] => LENGTH
@END
@TITLE FTN05.12(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
PROC SAVE.DATA
@BOX 2.0
SAVE DATA ANALYSIS RECORD
@BOX 3.0
END
@BOX 1.1
:: @@@ BCT start of new code
;PROC SAVE.DATA(NAME,CLIST)
;$IN I,J
;ADDR [$IN] AR
;ADDR DATA.LIST NODE
@BOX 2.1
;IF CLIST > 0 THEN
   MAKE.DATA.LIST(LOCAL.SPACE) => NODE
  ;DATA.LIST.ROOT => NEXT OF NODE^
  ;NODE => DATA.LIST.ROOT
  ;CLIST => I
  ;WHILE AS[I] >= 0 DO
       SAVE.CONST(AS[I+3],AS[I+2])
     ; 4+>I OD
  ;MAKE.IN(I-CLIST+9,LOCAL.SPACE)=>AR=> ARP OF NODE^
  ;3 => AR^[0]
  ;8 => AR^[1]
  ;-1 => AR^[2]
  ;5 => AR^[3]
  ;-1 => AR^[4]
  ;NAME => AR^[5]
  ;0 => AR^[6] => AR^[7]
  ;CLIST => I
  ;7 => J
  ;WHILE AS[I] >= 0 DO AS[I] => AR^[1+>J]
        ; 1+>I OD
  ;-1 => AR^[1+>J]
  ;SAVE.PROPS () => PROPS.P OF NODE^
  ; FAULT (151,1)
 FI
@BOX 3.1
END
@END

@TITLE FTN05.13(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
SAVE PROPS
@BOX 2.0
SAVE PROPERTY INDEX TABLE
@BOX 3.0
END
@BOX 1.1
:: @@@ BCT start of new code
;PROC SAVE.PROPS
;$IN I
@BOX 2.1
;IF PROPS.T.DUMP.G = NIL.PROPS THEN
   ;MAKE.PROPS(PROPS.I+1,LOCAL.SPACE)=>PROPS.T.DUMP.G
 FI
;FOR I < PROPS.I  + 1 DO
   ;PROPS.T[I] => PROPS.T.DUMP.G^[I]
;OD
;PROPS.T.DUMP.G => SAVE.PROPS
@BOX 3.1
END
@END
@TITLE FTN05.14(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
SCAN.EXPR
@BOX 2.0
RECUSIVELY EXAMINE EACH
NODE FOR CONSTANT, AND SAVE IT
@BOX 3.0
END
@BOX 1.1
;PROC SCAN.EXPR(AP)
;$IN T
@BOX 2.1
;IF AS[AP]=>T & %10 = 0 THEN
    SCAN.EXPR(AS[AP+1])
   ;SCAN.EXPR(AS[AP+2])
 ELSE IF T & %F = 0 THEN
    SAVE.CONST(AS[AP+2],T->>12& %F) FI
 FI
@BOX 3.1
END
@END
@TITLE FTN05.15(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
SAVE CONST
@BOX 2.0
COPY CONST TO LOCAL SPACE
UPDATE PROPS TABLE
COPY CHARACTER STRING TO
LOCAL SPACE IF NECESSARY
@BOX 3.0
END
@BOX 1.1
;PROC SAVE.CONST(PP,TY)
;ADDR CONST.PROP CP
;ADDR [$LO8] STR1,STR2
;$IN I
;$IN32 KLUDGE.VAR
@BOX 2.1
;IF TY = 5 OR TY = 7 THEN
    ADDRESS OF PROPS.T[PP] => KLUDGE.VAR
   ;MAKE ($LO8, 1321, KLUDGE.VAR) => STR1
   ;-1 => I
   ;WHILE STR1^[1+>I] /= 0 DO OD
   ;MAKE.LO8(I+1,LOCAL.SPACE) => STR2
   ;WHILE I >= 0 DO STR1^[I] => STR2^[I]; 1->I OD
   ;BYTE(STR2) => ADDRESS OF PROPS.T[PP]
 ELSE
   ;COPY.CONST(CONST OF PROPS.T[PP],LOCAL.SPACE) =>
      CP => CONST OF PROPS.T[PP]
 FI
@BOX 3.1
END
:: @@@ BCT 7-JAN-82 End of new code
@END

