@X @~
~L3 COUK1247
80
~V7 56 2 -5
~D10
~H                    MUSS
~
~
~D10
~H             FTN061
~D10
~MMANCHESTER UNIVERSITY  -  CONFIDENTIAL~
~
~
                                                           ISSUE 10~
~V9 -1
~P
~V9 1
~YFTN061
~S1~M~OFORTRAN 77 COMPILER IMPLEMENTATION DESCRIPTION
~S1~M~OSection 6~
~S1~OSection 6. Specification Part Declarations
~S1~O1.1 General Description
~BIn Fortran the specification of an item used in a subprogram
unit may involve several statements, and these statements can
usually occur in any order. It is not possible for the compiler
to know the complete specification, and to do any processing
involving declarations until all specification statements have been read.
This section of the compiler
provides the declarative processing for this and also
the declarative processing for implicit declarations.~
~BThe following paragraphs describe the function of this
section interface.~
~BAt the end of the specification part of a program unit ANAL.SPECS is
envoked and its actions are~
~T% 6
~
1)
~IDeclare the subprogram~
~
2)
~IDeclare any items explicitly in COMMON~
~
3)
~IDeclare any items that are in COMMON because they have been
equivalenced with items in COMMON~
~
4)
~IDeclare any items that appear in EQUIVALENCE statements
but which are not in COMMON~
~
5)
~IProcess dummy arguments and declare variables for any
adjustable bounds encountered in dummy array characters.~
~
No further declarations are made at this point because of the
implicit type rules of FORTRAN.
~BWhenever an ENTRY statement is encountered then its dummy
arguments are also processed as in 5) above.~
~BImplicit declarations of variables and arrays are handled by the
interface procedure CHECK.IMPLICIT.DECL.
~BTwo procedures are provided for handling procedure specifications.
DECLARE.PROC.SPEC declares a MUTL procedure specification from
an argument specification (see section 12.2.12), while CHECK.SPEC
checks for consistance of use and updates the argument specification
for a procedure with that of a procedure reference.~
~S1~O1.2 Storage Allocation
~BStorage allocation can be controlled by the user explicitly
with the *MAP directive and with bit 8 of the compilers mode parameter.
Three forms of the *MAP directive enable code, commons and local data
to be mapped separately. The *MAP CODE directive has two arguments,
the first which is mandatory is the MUTL segment number in which
any following code is to be placed, the second argument is optional
and specifies the maximum size of the segment in bytes. The segment
specified should be declared to the MUTL by calling TL.SEG before the
*MAP CODE directive, using the ** facility (in columns 1 & 2). Note
that bit 15 of the compilation mode must be set for the ** commands
to be recognised. If the *MAP CODE directive is absent then segment 0
is created of a suitable default size and used. The *MAP CODE directive
may appear anywhere and as often in the program as necessary.
~BThe *MAP directive for commons has three arguments. The first
argument is the common block name enclosed by slashes (// should be
used for blank common). The second parameter specifies the segment
number and the third the segment size, these are the same as for
the *MAP CODE directive and specify the MUTL segment in which the
specified common block is to be placed. Any commons not explicitly
mapped by the user are allocated space with the local data, except
blank common which is always given a segment of its own.
~BThe *MAP DATA specifies the storage mapping for local data
and any unmapped commons. It has two parameters which specify the
segment number and size in bytes, as before. The *MAP DATA cannot
occur within a program unit, but only before it. The explicit
mapping of local data to the specified segment may be disabled
by giving a segment number of zero.
~BWhen bit 8 of the compile mode is set it enables certain local
data variables to be allocated on the stack, rather than in a segment.
These variables must be non-common, not equivalenced, and not initialised
in a DATA statement. Any variables which cannot be placed on the stack,
when this bit is set, are handled normally and given space in a segment.
~S1~O1.3 Non Standard Features
~BBit 8, when set allows certain uninitialised local data variables
to be placed on the stack, rather than in a segment, as previously
described.
~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 check permits an actual argument to be
array name for a dummy argument which is a scalar variable, and also
permits an actual argument to be a scalar variable for a dummy
argument which is an array.~
~BOn certain machines the selection of precision for the
data types may result in the EQUIVALENCE statement acting in a
non-standard manner.  For example, on a typical 16 bit
micro-computer, INTEGER and LOGICAL are 16 bit, REAL is
32 bit, and COMPLEX and DOUBLE PRECISION are 64 bits.  Thus
two INTEGERS may be equivalenced to one REAL.  The effect of
EQUIVALENCE is controlled by configuration parameters in
Section 0.
~S1~O2. Interfaces
~S1~O2.1 Section Interfaces used~
~
   Section  1: (Configuration Section)~
   Section  2: (Statement Driver)~
   Section  4: (Syntax Analysis)~
   Section  5: (Specification Statement Processing)~
   Section 11: (Expression Evaluation)~
   Section 12: (Property List Management)~
   Section 13: (Fault Monitoring)~
~S1~O2.2 Section Interfaces~
~
Exported Types:~
   EQUIV.PROP~
~
~
Exported Scalars:~
   TL.ZERO.G~
   TL.ONE.G~
   MUTLN.G~
   MUTLD.AN.G~
   MUTL.SEGN.G~
   PU.START.MUTLN.G~
   PU.LOCALS.N.G~
   PSPEC.CNT~
   PSPECN.G~
   BLANK.COM.G~
~
Exported Vectors:~
   SEG.TBL~
   AREA.TBL~
   SEG.Z.TBL~
~
Exported Procedures:~
   ANAL.SPECS~
   CHECK.SPECS~
   PROCESS.DUMMY.ARGUMENTS~
   DECLARE.PROC.SPEC~
   CHECK.IMPLICIT.DECL~
   GET.AREA~
~S1~O3. Implementation
~S1~O3.1 Outline of Operation
~S1~OANAL.SPEC()~
~BAs mentioned in the general description ANAL.SPECS has several
declarative functions, their outline of operation is as follows~
~T% 7
~
a)
~IDeclare subprogram. If the subprogram is a function or a subroutine
declare a MUTL specification
if one does not already exist. Finally start a procedure body and allocate
MUTL names for the dummy arguments.~
~
b)~IDeclare common. Each common block is processed in turn, the steps
involved are:~
~
1)
~IAll items declared in a common are in a list termed a COMMON.ITEM.LIST,
this list is scanned and the position of all common items determined.
During this scan all items in an EQUIVALENCE statement are put on
a COMMON.EQUIVALENCE.LIST, and also all items are put on the
EXPLICIT.COMMON.LIST (Note with some re-organisation of link usage this list sho
uld
not be needed, but instead re-use the COMMON.ITEM.LIST)~
~
2)
~IThe effects of equivalencing of all items on the COMMON.EQUIVALENCE.LIST
is determined, and all items which have been equivalenced into the common
are put at the EQUIVALENCE.LIST. Violations on use of common are
checked, and any increase in size of the common is determined.~
~
3)
~IIf the common area has been used in a previous program unit,
then the MUTL area of it is selected, otherwise a MUTL area is
allocated for it.~
~
4)
~IAll items in the EXPLICIT.COMMON.LIST are declared~
~
5)
~IAll items in the EQUIVALENCE.LIST are declared~
~
c)
~IDeclare local. All local entities on the LOCAL.LIST are processed
in turn by the following steps~
~
1)
~IIf item has already been declared or it is not in an equivalence statement
then there is no declarative action of this point.~
~
2)
~IThe effects of all items equivalenced with it is determined,
and also the size of area is bytes to declare all the items.
All such items are put on an EQUIVALENCE.LIST~
~
3)
~IA MUTL area is allocated.~
~
4)
~IAll items in the EQUIVALENCE.LIST are declared.~
~
d)
~IProcess dummy arguments. PROCESS.DUMMY.ARGUMENTS is invoked.~
~S1~M~OEQUIVALENCE PROCESSING
~BA recursive procedure ADD.TO.EQUIV.LIST is used to determine the
effects of equivalencing. Prior to calling this an EQUIVALENCE.LIST
is created and the relative position of one equivalenced item is
determined. The procedure ADD.TO.EQUIV.LIST is then called specifying
this item as the root equivalence item. ADD.TO.EQUIV.LIST then
determines the position within the item at which equivalencing occurs.
Each equivalence entry of all other 'nlist' items of the associated
EQUIVALENCE are processed in turn in the following steps~
~
1)
~ICalculate the position of equivalencing relative to item, then calculate
its position with respect to the root item. If the items position has
previously been determined (by earlier equivalencing or item being in
common) then check positions are equal, otherwise add item to EQUIVALENCE.LIST.~
~
2)
~IIf the entity associated with the item appeared in other 'nlists', then
call ADD.TO.EQUIV.LIST recursively to process each such occurrence
in an nlist, unless these nlist have previously been processed.~
~S1~OCHECK.SPECS(ARG.SPEC.1^.ARG.SPEC.2^)~
~BThe first parameter is the specification vector for a procedure (i.e.
function, subroutine, statement function) and the second a specification
vector for a reference to it. This procedure checks that
number, kind and type of the arguments, and the results is compatible
between the two. Due to the implicit type rules of Fortran the kind of
arguments is not always precisely known, for example if an actual
argument is an array element reference then the dummy could either be
a variable or an array. Therefore whenever there is any refinement in
argument specification the argument specification vector is updated.~
~S1~OPROCESS.DUMMY.ARGUMENTS(LOCAL.PROP^)~
~BThe parameter is that of an enclosing program unit, i.e. a function,
subroutine or entry. This procedure scans its dummy argument list
processes any adjustable array declarators, for each adjustable bound
a bound variable is declared, the expression for the bound evaluated
and saved in the bound variable.~
~S1~ODECLARE.PROC.SPEC(GLOBAL.PROP^,PROC.KIND)~
~BDeclares a MUTL procedure specification. At the beginning of a program
many 'empty' procedures are specified to MUTL, which are later
used for forward references to global program units (e.g. subroutine
calls). When a PROC.SPEC is needed, one from this pool is used.
At the end of each program unit the pool is topped up again.
If the pool is emptied this is a fatal error and the compiler aborts.
Three quantities are needed to maintain this pool of empty
procedures. The total size of the pool (MAX.PSPECS.L) declared
in the Configuration Section. The number remaining (PSPEC.CNT)
and the next MUTL name to be used (PSPECN.G).~
~S1~OCHECK.IMPLICIT.DECL(LOCALPROP^)~
~BThis procedure handles implicit data declarations. If the entity has
already been fully declared there is no action. Otherwise the
procedure performs one of the following declarative actions.~
~T# 7
~
a)~IDummy argument, set kind to scalar and inform MUTL of the items
kind and type.~
~
b)~IOtherwise declare item as scalar or array (if declarator
present).~
~S1~OGET.AREA(AREA.TYPE,SIZE)AREA.NO
~BThis procedure obtaines a data area of the required type and size
for data declarations. MUTL segments are created and MUTL area
mapped to them as necessary. P1 is encoded as follows:~
~3
~
   Bit 0 = 1  Area has SAVE attribute~
   Bit 1 = 1  Equivalencing required~
   Bit 2 = 1  Common area.~
~0
~
P2 specifies the area size in bytes.~
~S1~M~OINTERNAL PROCEDURE SPECIFICATION
~S1~ODECLARE.ITEM(LOCAL.PROP^)
~BDeclare item to MUTL, update local properties and check consistant
use of any current area (ie items all saved, items all character, etc)~
~S1~OADD.TO.EQUIV.LIST(EQUIV.ENTRY^)
~BDetermine equivalence effects of all items in an 'nlist' of an
EQUIVALENCE statement. Parameter is equivalence entry of the root
item of the 'nlist'~
~S1~OITEMS.EQUIV.POS(EQUIV.ENTRY^)POSITION
~BDetermine the relative position in bytes from the start of the item
that equivalencing occurs.
~S1~OCALCULATE.ITEM.SIZE(LOCAL.PROP^)SIZE
~BDetermine the size of item in terms of the basic unit in which
it is declared in MUTL.
~S1~ODECL.CHARACTER.TYPE(LOCAL.PROP^)
~BDeclares a MUTL type for the character variable.~
~S1~OCALC.Z(LOCAL.PROP^)SIZE
~BCalculates the size in bytes of a variable.~
~S1~O3.2 Data Structures~
~BAn equivalence property entry is made to retain information from the Equivalen
ce
statement. The type of the entry is EQUIV.PROP and it contains the
following fields.~
~T# 12
~
GR.LINK~IAll the entities present in the 'nlist' of an equivalence
statement are connected in a circular list using this link.
This is termed the group link.~
~
IGR.LINK~IAll the equivalence entries belonging to one item (because
it appears more than once in an 'nlist' are connected in a
circular list using this link. If there is only one entry
for the item the link points to itself. This is termed the
inter-group link.~
~
EQ.LP.A~IPointer to the local properties of the item associated with
this equivalence entry.~
~
EQ.NO.DIM~INo of dimension specified in the array element name in the
nlist.~
~
EQ.L.SS~IValue of lower substring specifier. Zero means not present.~
~
EQ.U.SS~IValue of upper substring specifier. Zero means not present.~
~
EQ.SUBS~IBounded pointer to a vector of integers containing the
array subscript element values.~
~
EQ.FLAG~IZero means entry not yet processed. 1 means processed.~
~BThe variable L.GET.AREA.TYP retains the type of the last area
allocated by the procedure GET.AREA.~
~Y
~V9 -1
~P
~D15
~HFLOWCHARTS
~
~
~H                FTN061
~V9 -1
~F
@TITLE FTN06(1,11)
@COL 1S-2R-3R-5R-6R-7R-9F
@FLOW 1-2-3-5-6-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
28-DEC-82 (BCT) First release of this section
ANALYSE SPECIFICATION STATEMENTS
@BOX 2.0
[IMPORTS FTN06/1]
MODULE HEADING
@BOX 3.0
TYPE DECLARATIONS
@BOX 5.0
SCALAR DECLARATIONS
@BOX 6.0
VECTOR DECLARATIONS
@BOX 7.0
PROCEDURES IN MODULE
   ANAL.SPECS:6.1:
   CHECK.SPECS:6.2:
   PROCESS.DUMMY.ARGUMENTS:6.3:
   DECLARE.PROC.SPECS:6.4:
   CHECK.IMPLICIT.DECL:6.5:
   INTERNAL PROCEDURES
   CALCULATE.ITEM.SIZE:6.6:
   GET AREA:6.8:
   CALC Z:6.9:
   GET.SEG :6.10:
   DECLARE.TL.ITEM :6.11:
   V.DECL :6.12:
   MUTL.TYPE :6.13:
   DECLARE.TL.BOUNDS :6.14:
@BOX 9.0
END
@BOX 2.1
#FTN06/1
;MODULE (TL.ZERO.G,TL.ONE.G,BLANK.COM.G,SEG.Z.TBL,DONE.DECLARATIONS,
         MUTLN.G,MUTL.DA.N.G,PU.START.MUTL.NG,MUTL.SEG.NG,GET.SEG,
         AREA.TBL,SEG.TBL,ANAL.SPECS,CHECK.SPECS,L.ACC.Z.G,I.ACC.Z.G,
         IND.ACC.Z.G,ACC.Z.G,PR.T,F.PR.T,V.DECL,MUTL.TYPE,VAL.ARG.Z.G,
         PROCESS.DUMMY.ARGUMENTS,DECLARE.PROC.SPEC,GET.AREA,PU.LOCALS.MUTL.NG,
         CHECK.IMPLICIT.DECL,EQUIV.PROP,PSPECN.G,PSPEC.CNT,MODE); :: @@@ BCT 28-
DEC-82
@BOX 3.1
; 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
@BOX 5.1
; *GLOBAL 2
;$LO16 TL.ZERO.G,TL.ONE.G,P.SPECN.G
;$IN MUTLN.G,MUTL.DAN.G,MUTL.SEGN.G,DONE.DECLARATIONS
;$IN PU.START.MUTLN.G,PU.LOCALS.MUTL.NG,P.SPEC.CNT
;ADDR COMMON.PROP BLANK.COM.G
;$IN L.GET.AREA.TYP
;$IN L.ACC.Z.G,I.ACC.Z.G,IND.ACC.Z.G,VAL.ARG.Z.G :: @@@ BCT 28-DEC-82
@BOX 6.1
;$LO8 [7] PR.T
;$LO8 [5] F.PR.T
;$LO8 [ACC.Z.Z.L] ACC.Z.G :: @@@ BCT 28-DEC-82
;$LO16[3] AREA.TBL
;$IN[3] SEG.TBL
;ADDR[3] SEG.Z.TBL
;*GLOBAL 7
;DATAVEC MODE($LO16)
%00 %00 %108 %40 %80 %80 %83
END
; *GLOBAL 0
@BOX 7.1
;P.SPEC ANAL.SPECS()
;P.SPEC CHECK.SPECS(ADDR[$LO8],ADDR[$LO8])/$IN
;P.SPEC PROCESS.DUMMY.ARGUMENTS(ADDR LOCAL.PROP)
;P.SPEC DECLARE.PROC.SPEC(ADDR[$LO8],$IN,ADDR[$LO8])/$IN
;P.SPEC CHECK.IMPLICIT.DECL(ADDR LOCAL.PROP)/$IN
;PSPEC CALCULATE.ITEM.SIZE(ADDR LOCAL.PROP)/$IN32
;PSPEC CALC.Z(ADDR LOCAL.PROP)/$IN32
;PSPEC GET.AREA($IN,$IN)/$IN
;P.SPEC GET.SEG()/$IN
;PSPEC DECLARE.TL.ITEM(ADDR LOCAL.PROP)
;PSPEC V.DECL($IN, $IN, $IN)/$IN
;PSPEC MUTL.TYPE($IN,$IN)/$IN
;PSPEC DECLARE.TL.BOUNDS(ADDR LOCAL.PROP)
#FTN06.1
#FTN06.2
#FTN06.3
#FTN06.4
#FTN06.5
#FTN06.6
#FTN06.8
#FTN06.9
#FTN06.10
#FTN06.11
#FTN06.12
#FTN06.13
#FTN06.14
@BOX 9.1
;*END
@END
@TITLE FTN06/1(1,11)
@COL 1S-2R
@COL 3R-4R-5R-6R-7F
@FLOW 1-2-3-4-5-6-7
@BOX 1.0
DECLARATION IMPORTS
@BOX 2.0
IMPORTED TYPES
@BOX 3.0
IMPORTED LITERALS
@BOX 4.0
IMPORTED SCALARS
@BOX5.0
IMPORTED VECTORS
@BOX 6.0
IMPORTED PROCEDURES
@BOX 7.0
END
@BOX 2.1
; IMPORT TYPE CONST.PROP
;TYPE PROPS;
; TYPE EQUIV.PROP ;
;TYPE NAME.T IS $AD[$LO8] NAME
;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 DATA.LIST IS
      ADDR [$IN] ARP
      ADDR [PROPS] PROPS.P
      ADDR DATA.LIST NEXT;
;TYPE FORMAT.LIST IS
      ADDR LABEL.PROP F.LABEL
      $IN F.BND
      ADDR [$IN] F.TABLE
      ADDR [$LO8] F.STRINGS
      ADDR FORMAT.LIST NEXT;
;TYPE ENTRY.LIST IS
      $IN STAT.AP.ENTRY
      ADDR [$IN] ARP
      ADDR [PROPS] E.PROPS
      ADDR ENTRY.LIST NEXT
@BOX 3.1
;IMPORT LITERAL $LO32 ON.STACK.BIT.L
;IMPORT LITERAL $LO32 MAX.SEG.Z.L, MAX.POS.SEG.Z.L
;IMPORT LITERAL I.ACC.T.L,
   R.ACC.T.L, DP.ACC.T.L,
   L.ACC.T.L, C.COMP.ACC.T.L,
   D.ARG.TYPE.L, BASE.OP.L, PROPS.Z.L,
   STR.ARR.BASE.OP.L, ARG.CH.T, SU.SIZE.L, ACC.Z.Z.L,
   ROUNDING.MASK.L, ST.CH.Z.L, AS.Z.L, LOCAL.SPACE,
   FMT.TABLE.EL.TYPE.L, GLOBAL.SPACE
@BOX 4.1
;ADDR LOCAL.PROP F.L.PROP.G,L.CUR.PU,LOCAL.LIST.ST.G
;ADDR COMMON.PROP F.C.PROP.G,COM.LIST.G
; $IN32 F.I.G
; $IN END.AP.G,PROPS.I,A.AP.G,ALL.SAVE.G,STAT.NO
; $LO8 PU.G
; ADDR [$LO8] CUR.ARG.SPEC.G
; ADDR GLOBAL.PROP G.CUR.PU
; LABEL ABORT.COMPILE
; $LO32 INFORM.LINE.G
; $IN STAT.AP.G
; ADDR ENTRY.LIST ENTRY.LIST.ROOT
; ADDR FORMAT.LIST FORMAT.LIST.ROOT
; ADDR DATA.LIST DATA.LIST.ROOT
@BOX 5.1
; PROPS[PROPSZ.L] PROPS.T
; $LO8 [26] IMPLICIT.G
; $IN [26] IMPLICIT.LEN.G
; $LO8 [ST.CH.Z.L] ST.CH
; $IN [AS.Z.L] AS
;$LO8[32]SEG.INFO
@BOX 6.1
;P.SPEC ALLOCATE.SEG($IN,$IN)
;P.SPEC REDUCE.EXPR($IN)/$IN
;P.SPEC CODE.EXPR($IN,$IN)/$IN
;P.SPEC PL.ARITH.FN($IN,$IN)
;P.SPEC FAULT($IN,$IN)
;P.SPEC SET.A.TYPE($IN,$IN)
;P.SPEC MAKE.PROPS($IN,$IN)/ADDR [PROPS]
;P.SPEC MAKE.IN($IN,$IN)/ADDR [$IN]
;P.SPEC DATA()
;P.SPEC ENTRY()
;L.SPEC TL.S.DECL(ADDR[$LO8],$IN,ADDR)
;L.SPEC TL.PROC($IN)
;L.SPEC TL.EQUIV.POS(ADDR)
;L.SPEC TL.DATA.AREA($IN)
;L.SPEC TL.SET.TYPE($IN,$IN)
;L.SPEC TL.PL($IN,$IN)
;L.SPEC TL.C.LIT.16($IN,$IN16)
;L.SPEC TL.C.LIT.32($IN,$IN32)
;L.SPEC TL.C.LIT.S($IN,$AD[$LO8])
;L.SPEC TL.PROC.SPEC(ADDR[$LO8],$IN)
;L.SPEC TL.PROC.PARAM($IN,ADDR)
;L.SPEC TL.PARAM.NAME($IN, ADDR[$LO8])
;L.SPEC TL.PROC.RESULT($IN)
;L.SPEC TL.LOAD($IN,$IN)
; L.SPEC TL.BLOCK()
;L.SPEC TL.ASS($IN,$IN)
;L.SPEC TL.ASS.VALUE($IN,$IN)
;L.SPEC TL.ASS.END()
;L.SPEC TL.COMMON(ADDR [$LO8], $IN32, $IN)
;L.SPEC TL.END.COMMON ()
;L.SPEC TL.BOUNDS($IN,ADDR[$IN])
@END
@TITLE FTN06.1(1,11)
@COL 1S-2R-3R-4R-5R-8T-6R-9R-7F
@FLOW 1-2-3-4-5-8N-6-9-7
@FLOW 8Y-9
@BOX 1.0
ANAL SPECS
@BOX 2.0
INTERNAL PROCEDURES
DECLARE.ITEM:6.1.4:
ADD.TO.EQUIV.LIST:6.1.5:
ITEM.EQUIV.POSITION:6.1.6:
REPLACE.AS:6.1.7:
@BOX 3.0
DECLARE SUBPROGRAM:6.1.1:
@BOX 4.0
DECLARE COMMON:6.1.2:
@BOX 5.0
DECLARE LOCAL:6.1.3:
@BOX 6.0
PROCESS DUMMY ARGUMENTS:6.3:
@BOX 7.0
END
@BOX 8.0
NEITHER SUBR OR FN
@BOX 9.0
SELECT DATA AREA 0
DECLARE ANY SAVED DATA INITIALISATION:6.1.8:
DECLARE ANY SAVED FORMATS:6.1.9:
DECLARE ANY STORED ENTRIES:6.1.10:
REINSTATE STORED AS IF NECESSARY:6.1.11:
@BOX 1.1
;PROC ANAL.SPECS
;$IN AREA.T,AREA.S,AREA.Z
;ADDR LOCAL.PROP EQUIV.LIST.P
;LITERAL/ADDR [$LO8] NIL.STR=
:: @@@ BCT 28-DEC-82 Strat of new code
;$IN SAVE.STAT.AP
;LITERAL/ADDR[$IN] NIL.AR =
;LITERAL/ADDR[PROPS] NIL.PROPS =
;ADDR [PROPS] DUMP.PR,CURRENT.PR
;ADDR [$IN] DUMP.AR
;NIL.AR => DUMP.AR
;NIL.PROPS => DUMP.PR => CURRENT.PR
:: @@@ BCT 28-DEC-82 end of new code
;1 => DONE.DECLARATIONS
@BOX 2.1
;PSPEC DECLARE.ITEM(ADDR LOCAL.PROP)
;PSPEC ADD.TO.EQUIV.LIST(ADDR EQUIV.PROP)
;PSPEC ITEM.EQUIV.POS(ADDR EQUIV.PROP)/$IN
;P.SPEC REPLACE.AS(ADDR[$IN],ADDR[PROPS]) :: @@@ BCT 28-DEC-82
#FTN06.1.4
#FTN06.1.5
#FTN06.1.6
#FTN06.1.7
@BOX 3.1
#FTN06.1.1
@BOX 4.1
#FTN06.1.2
@BOX 5.1
#FTN06.1.3
@BOX 6.1
;PROCESS.DUMMY.ARGUMENTS(L.LINK1 OF L.CUR.PU^)
@BOX 7.1
;END
@BOX 8.1
;IF PU.G /= 2 /= 3
@BOX 9.1
;TL.DATA.AREA(0)
#FTN06.1.8
#FTN06.1.9
#FTN06.1.10
#FTN06.1.11
@END
@TITLE FTN06.1.1(1,11)
@COL 7T-8R-10R-11T-31T-5R-19R-20T-21R-22T-23R-4R-15F
@COL 1S-17R-2T-3R-6T-30R-32R-18R-16R-24R
@ROW 7-2
@FLOW 1-17-2N-3-6N-7N-8-10-11N-31N-5-19-20N-21-22N-23-4-15
@FLOW 2Y-16-4
@FLOW 6Y-11
@FLOW 7Y-10
@FLOW 11Y-30-18-19
@FLOW 31Y-32-18
@FLOW 20Y-4
@FLOW 22Y-24-4
@ROW 23-24
@ROW 11-18
@BOX 1.0
DECLARE SUBPROGRAM
@BOX 2.0
PU BLOCKDATA OR MPU?
@BOX 3.0
SCAN DUMMY ARGUMENT LIST
AND SET TYPE OF ANY UNTYPED NON LABEL ARGUMENTS
AND COMPLETE ARGUMENT SPECIFICATION
@BOX 4.0
NOTE MUTLNAME OF START
OF PU LOCALS
@BOX 5.0
DECLARE PROC AS EXPORT
@BOX 6.0
SUBROUTINE?
@BOX 7.0
FUNCTION TYPED?
@BOX 8.0
SET IMPLICIT TYPE
@BOX 10.0
SAVE RESULT INFO IN ARGUMENT SPEC
@BOX 11.0
SUBROUTINE NOT PREVIOUSLY REFERENCED
@BOX 18.0
DECLARE TL.SPEC FOR SUBPROGRAM
@BOX 15.0
END
@BOX 16.0
START BLOCK
@BOX 17.0
SAVE MUTL.G SO IT CAN
BE RESET AT END OF PU
@BOX 19.0
START SUBR/FN BODY
ALLOCATE MUTL NAMES TO DUMMY ARGUMENTS
GIVE MUTL SYMBOLIC NAMES OF ARGUMENTS
IF DUMMY ARG OF CHAR TYPE
ALLOCATE MUTL NAME FOR ITS LENGTH
@BOX 20.0
SUBROUTINE
@BOX 21.0
CHANGE LOCAL KIND
TO SCALAR VARIABLE
NOTE MUTL NAME OF RESULT
@BOX 23.0
DECLARE RESULT VARIABLE
@BOX 22.0
RESULT TYPE CHAR?
@BOX 24.0
SET DUMMY ARG BIT SO THAT
RESULT IS ACCESSED BY D =
ALLOCATE 2 MUTL NAMES
ONE TO REFN RESULT
ONE TO SPECIFY ITS LENGTH
NOTE MUTL NAME CONTAINING LENGTH
IF ASSUMED SIZE LENGTH
@BOX 30.0
GET PROC TYPE
@BOX 31.0
DIFFERENT NUMBER OF MUTL PARAMETERS?
@BOX 32.0
SET PROC TYPE
@BOX 1.1
;BEGIN
;$IN I,LS,CH,T,LT, L
;ADDR LOCAL.PROP LP
;LITERAL/ADDR LOCAL.PROP NIL.LP=
;ADDR [$LO8] GAS
;LITERAL/ADDR [$LO8] NIL.STR=
@BOX 4.1
;MUTLNG => PU.LOCALS.MUTL.NG
@BOX 16.1
; TL.BLOCK()
@BOX 17.1
;MUTL.NG => PU.START.MUTL.NG
@BOX 2.1
;IF PU.G < 2
@BOX 3.1
;L.LINK1 OF L.CUR.PU^ => LP
;0=>I
;WHILE LP/= NIL.LP DO
   ;IF L.SPECS OF LP^=>LS & %80 =0 THEN
      ;IMPLICIT.G[ST.CH[NAME^[0] OF L.NAME  OF LP^]
           =>CH]=>LTYPE OF LP^ :: ??? JM 27-DEC-82
      ;IF IMPLICIT.LEN.G[CH] => L.LEN OF LP^ < 0 THEN
         ;ACC.Z.G[L.TYPE OF LP^] => L.LEN OF LP^
      ;FI
   ;FI
   ;WHILE CUR.ARG.SPEC.G^[2+>I] /= 0 DO OD
   ;L.TYPE OF LP^=>CUR.ARG.SPEC.G^[I]
   ;L.LEN OF LP^ => CUR.ARG.SPEC.G^[I + 1]
   ;L.LINK.1 OF LP^=>LP
;OD
@BOX 6.1
;IF PU.G = 2
@BOX 7.1
;IF L.SPECS OF L.CUR.PU^ & %80/=0
@BOX 8.1
;IMPLICIT.G[ST.CH[NAME^[0] OF L.NAME OF L.CUR.PU^] => CH]
     => L.TYPE OF L.CUR.PU^ :: ??? JM 27-DEC-82
;IF IMPLICIT.LEN.G[CH] =>L < 0 THEN
   ;ACC.Z.G[L.TYPE OF L.CUR.PU^] => L
;FI
;L => L.LEN OF L.CUR.PU^
@BOX 21.1
;MUTL.NG => L.TL.NAME OF L.CUR.PU^
;1 => L.KIND OF L.CUR.PU^
@BOX 23.1
;TL.DATA.AREA(0)
;V.DECL(T, L.LEN OF L.CUR.PU^, 0)
@BOX 10.1
;L.TYPE OF L.CUR.PU^ => T => CUR.ARG.SPEC.G^[0]
;IF T = 5 THEN 0 => CUR.ARG.SPEC.G^[1] ELSE
 L.LEN OF L.CUR.PU^ => CUR.ARG.SPEC.G^[1] FI
@BOX 11.1
;IF G.ARG.SPEC.P OF G.CUR.PU^=>GAS = NIL.STR
@BOX 15.1
;END
@BOX 30.1
;IF G.TL.NAME $OF G.CUR.PU^ => T /= 0 THEN
     ;%1000 !> T
;FI
@BOX 18.1
;DECLARE.PROC.SPEC(CUR.ARG.SPEC.G,T!%4000,
     NAME OF G.NAME OF G.CUR.PU^)
     => G.TL.NAME OF G.CUR.PU^ :: ??? JM 27-DEC-82
@BOX 19.1
;TL.PROC(G.TL.NAME OF G.CUR.PU^)
;L.CUR.PU => LP
;WHILE L.LINK.1 OF LP^ => LP /= NIL.LP DO
    ;TL.PARAM.NAME(MUTL.NG, NAME OF L.NAME OF LP^) :: ??? JM 27-DEC-82
   ;MUTL.N.G => L.TL.NAME OF LP^ + 1 => MUTL.NG
;IF L.TYPE OF L.P^ = 5 THEN
   ;IF L.LEN OF LP^ < 0 THEN
      ;0 - MUTL.N.G => L.LEN OF L.P^
   FI
   ;1 +> MUTL.N.G
;FI
;OD
@BOX 20.1
;IF PU.G = 2
@BOX 22.1
;IF L.TYPE OF L.CUR.PU^ => T = 5
@BOX 24.1
;%200 !> L.SPECS OF L.CUR.PU^
;IF L.LEN OF L.CUR.PU^ < 0 THEN
   ;-1 -MUTLNG => L.LEN OF L.CUR.PU^
;FI
;2 +> MUTL.N.G
@BOX 5.1
;TL.PROC.SPEC(NAME OF G.NAME OF G.CUR.PU^,G.TL.NAME OF G.CUR.PU^ ! %5000)
@BOX 31.1
;IF SIZE(GAS) /= SIZE(CUR.ARG.SPEC.G) THEN
   ;1 => CH
;ELSE
   ;0 => CH
   ;-2 => I
   ;WHILE GAS^[2+>I] => T /= %FF DO
      ;IF T & 7 = 5 THEN 1 +> CH FI
      ;IF CUR.ARG.SPEC.G^[I] & 7 = 5 THEN 1->CH FI
   ;OD
;FI
;IF CH /= 0
@BOX 32.1
;0 => T
@END
@TITLE FTN06.1.2(1,7)
@COL 1S-2R-3T-4T-5R-6R-7R-9T-11R-12T-13R-14R-15R-8R-16R-17R
@COL 18R-19F
@FLOW 1-2-3N-4N-5-6-7-9N-11-12N-13-14-9
@FLOW 3Y-18-19
@FLOW 4Y-17
@FLOW 9Y-15-8-16-17-3
@FLOW 12Y-14
@ROW 4-18
@BOX 1.0
DECLARE COMMON
@BOX 2.0
GET FIRST COMMON
@BOX 3.0
ALL COMMONS PROCESSED
@BOX 4.0
COMMON NOT USED IN THIS PU
@BOX 5.0
INIT COMMON.EQUIVALENCE LIST
INIT EXPLICIT DECLARATION LIST
@BOX 6.0
SET AREAZ TO ZERO
RESET AREA TYPE(IE NEITHER
CHAR NO NON CHAR COMMON)
NOTE AREA NOT TO CONTAIN SAVED ITEMS
@BOX 7.0
GET FIRST ITEM IN COMMON
@BOX 9.0
NO MORE ITEMS IN COMMON
@BOX 11.0
CALCULATE SIZE IN BYTES:6.9:
SAVE ITS POSITION
UPDATE COMMON SIZE
ADD TO EXPLICIT DECL LIST
@BOX 12.0
ITEM NOT IN EQUIVALENCE STATEMENT
@BOX 13.0
ADD TO COMMON EQUIVALENCE LIST
@BOX 14.0
GET NEXT ITEM
@BOX 15.0
PROCESS COMMON EQUIVALENCES:6.1.2.1:
@BOX 8.0
DECLARE ITEMS IN COMMON
:6.1.2.3:
@BOX 16.0
CHECK AND UPDATE COMMON USE:6.1.2.2:
@BOX 17.0
GET.NEXT COMMON
@BOX 18.0
SET TYPE OF AREA
LAST USED
@BOX 19.0
END
@BOX 1.1
;BEGIN
;$IN CK,T
;ADDR COMMON.PROP CP
;LITERAL/ADDR COMMON.PROP NIL.CP=
;ADDR LOCAL.PROP C.EQ.L.P,C.EXP.HD,C.EXP.TAIL,L.P,NLP
;LITERAL/ADDR LOCAL.PROP NILLP=
@BOX 2.1
;COM.LIST.G=> CP
@BOX 3.1
;CP => F.C.PROP.G
;IF CP=NIL.CP
@BOX 4.1
;IF CKIND OF CP^=>CK & %10=0
@BOX 5.1
;NIL.LP=>C.EXP.HD=>C.EXP.TAIL=>C.EQ.LP
@BOX 6.1
;0=>AREA.Z=>AREA.T=>AREA.S
@BOX 7.1
;C.HEAD OF C.P^=>L.P
@BOX 9.1
;IF L.P = NIL.LP
@BOX 11.1
;%4000 !> L.SPECS OF LP^
;AREA.Z => L.DISP OF L.ALT OF LP^
;CALC.Z(LP)+>AREA.Z
;IF C.EXP.HD = NIL.LP THEN
  ;LP=>C.EXP.HD=>C.EXP.TAIL
;ELSE
  ;LP=>L.LINK.2 OF C.EXP.TAIL^ => C.EXP.TAIL
;FI
;NIL.LP=> L.LINK2 OF LP^
@BOX 12.1
;L.LINK1 OF LP^=>NLP
;IF L.SPECS OF LP^ & 8 =0
@BOX 13.1
;C.EQ.L.P=>L.LINK.1 OF L.P^
;LP=>C.EQ.L.P
@BOX 14.1
;NLP=>LP
@BOX 15.1
#FTN06.1.2.1
@BOX 16.1
#FTN06.1.2.2
@BOX 17.1
;C.PREV.P OF C.P^=>CP
@BOX 8.1
#FTN06.1.2.3
@BOX 18.1
;IF COM.LIST.G /= NIL.CP THEN
   ;2 => L.GET.AREA.TYP
;FI
@BOX 19.1
;END
@END
@TITLE FTN06.1.2.1(1,10)
@COL 1S-2R-3T-4R-6T-7R-8T-9T-10T-26R-13T-14R-15R
@COL 16N-18F-20R-21R
@ROW 3-16
@ROW 6-18
@ROW 10-20
@FLOW 1-2-3NO-4-6NO-7-8NO-9NO-10NO-26-13NO(RH EXT IN COM)-14-15-8YES-18
@FLOW 3YES(NO EQS)-16-18
@FLOW 6YES-4
@FLOW 9YES-20-15
@FLOW 10YES(LN EXT IN COM)-21-15
@FLOW 13Y-15
@BOX 1.0
PROCESS COMMON EQUIVALENCES
@BOX 2.0
INIT EQUIVALENCE LIST
@BOX 3.0
OBTAIN FIRST ITEM IN COM EQUIV LIST
NO COM EQUIVALENCES?
@BOX 4.0
CREATE EQUIVALENCE LIST:6.1.5:
@BOX 6.0
ANY MORE ITEMS IN COMMON
EQUIVALENCE LIST
@BOX 7.0
GET FIRST ITEM IN EQUIVALENCE LIST
@BOX 8.0
END OF EQUIV LIST?
@BOX 9.0
ITEM IN AN UNDECLARED COMMON?
@BOX 10.0
LH EXT?
@BOX 26.0
CALC SIZE OF ITEM IN BYTES:6.9:
CALC RH POS OF ITEM
@BOX 13.0
NO RHS EXT OF COMMON?
@BOX 14.0
NOTE NEW SIZE OF COMMON
@BOX 15.0
GET NEXT ITEM IN
EQUIV LIST
@BOX 18.0
END
@BOX 20.0
FAULT
@BOX 21.0
FAULT
@BOX 1.1
@BOX 2.1
;NIL.LP=>EQUIV.LIST.P
@BOX 3.1
;IF C.EQ.LP=>LP=NIL.LP
@BOX 4.1
;ADD.TO.EQUIV.LIST(L.EQT.P OF L.ALT OF LP^)
@BOX 6.1
;IF L.LINK1 OF LP^ => LP /= NIL.LP
@BOX 7.1
;EQUIV.LIST.P => LP
@BOX 8.1
;IF LP = NIL.LP
@BOX 9.1
;IF L.SPECS OF L.P^ & %2010 = %10
@BOX 10.1
;IF L.DISP OF L.ALT OF L.P^ => T < 0
@BOX 26.1
;CALC.Z(LP)+>T
@BOX 13.1
;IF AREA.Z >= T
@BOX 14.1
;T=>AREA.Z
@BOX 15.1
;L.LINK2 OF LP^ => LP
@BOX 18.1
@BOX 20.1
;LP => F.L.PROP.G
;FAULT(82,1)
@BOX 21.1
;CP => F.C.PROP.G
;FAULT(83,2)
@END
@TITLE FTN06.1.2.2(1,11)
@COL 9R-10R-11R
@COL 1S-2T-3T-4T-5T-6T-7R-8F
@COL 13T-12R-14T-15R
@ROW 9-4
@ROW 3-13
@FLOW 1-2N-3N-4N-5N-6N-7-8
@FLOW 2Y-13N-12-7
@FLOW 13Y-14N-7
@FLOW 14Y-15-7
@FLOW 3Y-9-4Y-10-5
@FLOW 5Y-7
@FLOW 6Y-11-7
@BOX 1.0
CHECK AND UPDATE
COMMON ENTRY
@BOX 2.0
COMMON NOT PREVIOUSLY USED?
@BOX 3.0
SAVE USED CONSISTENTLY IN THIS
AND PREVIOUS PUS?
@BOX 4.0
TYPE CONSISTENT IN THIS
AND PREVIOUS PUS?
@BOX 5.0
BLANK COMMON?
@BOX 6.0
COMMON OF DIFFERENT SIZE?
@BOX 7.0
RESET SAVED IN THIS PU BIT
FROM COMMON ENTRY
@BOX 8.0
END
@BOX 9.0
FAULT
@BOX 10.0
FAULT
@BOX 11.0
FAULT
@BOX 12.0
UPDATE COMMON ENTRY
FOR SAVE,TYPE AND SIZE
@BOX 13.0
BLANK COMMON?
@BOX 14.0
BLANK COMMON TOO BIG?
@BOX 15.0
FAULT
@BOX 1.1
@BOX 2.1
;IF CK & 6=0
@BOX 3.1
; CP => F.C.PROP.G
;IF CK & %21 /= 0 /= %21
@BOX 4.1
;IF CK & 6 /= AREA.T
@BOX 5.1
;IF  CP = BLANK.COM.G
@BOX 6.1
;IF C.SIZE OF C.P^ /= AREA.Z
@BOX 7.1
;C.K & %FE => C.KIND OF C.P^
@BOX 8.1
@BOX 9.1
;FAULT(84,2)
@BOX 10.1
;FAULT(85,2)
@BOX 11.1
FAULT(86,2)
@BOX 12.1
;AREA.Z => C.SIZE OF C.P^
;CK&1 <<- 5 !AREA.T !> CK
@BOX 13.1
;IF CP = BLANK.COM.G
@BOX 14.1
;IF AREA.Z =< C.SIZE OF C.P^
@BOX 15.1
;FAULT(134,6)
@END
@TITLE FTN06.1.2.3(1,11)
@COL 1S-10T-3R-4R-5R-6R-7F
@FLOW 1-10N-3-4-5-6-7
@FLOW 10Y-4
@BOX 1.0
DECLARE ITEMS IN COMMON
@BOX 3.0
SET MAX SIZE
@BOX 4.0
DECLARE ALL ITEMS EXPLICITLY
IN COMMON :6.1.4:
@BOX 5.0
DECLARE ALL ITEMS EQUIVALENCED
INTO COMMON :6.1.4:
@BOX 6.0
END COMMON DEF
@BOX 7.0
END
@BOX 10.0
DEFINE COMMON
NAMED COMMON?
@BOX 1.1
@BOX 3.1
;MAX.SEG.Z.L=>C.SIZE OF CP^
@BOX 4.1
;WHILE C.EXP.HD /= NIL.LP DO
      ;DECLARE.ITEM(C.EXP.HD)
      ;L.LINK.2 OF C.EXP.HD^ => C.EXP.HD
;OD
@BOX 5.1
;WHILE EQUIV.LIST.P /= NIL.LP DO
      ;TL.EQUIV.POS(L.DISP OF L.ALT OF EQUIV.LIST.P^)
      ;DECLARE.ITEM(EQUIV.LIST.P)
      ;L.LINK2 OF EQUIV.LIST.P^ => EQUIV.LIST.P
;OD
@BOX 6.1
;TL.END.COMMON ()  ::jae 12/30
@BOX 7.1
@BOX 10.1
;TL.COMMON (NAME OF C.NAME OF C.P^, AREA.Z, 0)
;IF CP  /= BLANK.COM.G
@END

@TITLE FTN06.1.3(1,6)
@COL 1S-2R-3T-4T-5T-10R-11R
@COL 12F
@ROW 4-12
@FLOW 1-2-3N-4N-5N-10-11-3Y-12
@FLOW 4Y-11
@FLOW 5Y-11
@BOX 1.0
DECL LOCAL
@BOX 2.0
GET FIRST ITEM IN LOCAL LIST
@BOX 3.0
NO MORE ITEMS?
@BOX 4.0
ITEM DECLARED?
@BOX 5.0
ITEM NOT EQUIVALENCED?
@BOX 11.0
GET NEXT ITEM IN
LOCAL LIST
@BOX 12.0
END
@BOX 10.0
PROCESS LOCAL EQUIV:6.1.3.1:
@BOX 1.1
;BEGIN
;ADDR LOCAL.PROP LP,ELP
;LITERAL/ADDR LOCAL.PROP NIL.LP =
;$IN LS,Z,MZ,POS




@BOX 2.1
;LOCAL.LIST.ST.G => LP
@BOX 3.1
;IF LP = NIL.LP
@BOX 4.1
;IF L.SPECS OF LP^ => LS & %2000 /= 0
@BOX 5.1
;IF LS & 8 = 0
@BOX 11.1
;L.LINK.1 OF LP^ => LP
@BOX 12.1
;END
@BOX 10.1
#FTN06.1.3.1
@END
@TITLE FTN06.1.3.1(1,6)
@COL 1S-2R-3R-4R-5R-6R-7R-8R-9R-10R-11T-13R-12F
@FLOW 1-2-3-4-5-6-7-8-9-10-11N-13-12
@FLOW 11Y-9
@BOX 1.0
PROCESS LOCAL EQUIVALENCES
@BOX 2.0
PUT ITEM ON
EQIVALENCE LIST
@BOX 3.0
SET POSITION OF ITEM (BASE ITEM) TO ZERO
AND MARK AS POSITION DETERMINED
@BOX 4.0
ADD.TO.EQUIV.LIST:6.1.5:
ALL ITEMS EQIVALENCED TO THIS ONE
@BOX 5.0
SET POS OF ALL ITEMS FROM
START OF AREA
CALCULATE AREA SIZE
@BOX 6.0
GET FIRST ITEM ON EQUIVALENCE LIST
@BOX 7.0
NOTE AREA.TYPE
NOTE WHETHER AREA SAVED OR NOT
@BOX 8.0
GET AREA:6.8:
@BOX 9.0
SELECT POSITION WITHIN AREA
FOR DECLARATION
@BOX 10.0
DECLARE ITEM:6.1.4:
@BOX 11.0
ANY MORE ITEMS ON EQIVALENCE LIST
@BOX 12.0
END
@BOX 13.0
RESELECT DATA AREA 0
@BOX 1.1
@BOX 2.1
;LP => EQUIV.LIST.P
;NIL.LP=> L.LINK.2 OF LP^
@BOX 3.1
; 0 => L.DISP OF L.ALT OF LP^
; %4000 !> L.SPECS OF LP^
@BOX 4.1
;ADD.TO.EQUIV.LIST(L.EQT.P OF LALT OF LP^)
@BOX 5.1
;0 => Z
;EQUIV.LIST.P => ELP
;WHILE ELP /= NIL.LP DO
   ;IF L.DISP OF L.ALT OF ELP^ => MZ < Z THEN
      ;MZ => Z
;FI
   ;L.LINK.2 OF ELP^ => ELP
;OD
;0=>AREA.Z
;EQUIV.LIST.P=>E.L.P
;WHILE ELP /= NIL.LP DO
  ;Z->L.DISP OF L.ALT OF ELP^=>MZ
  ;IF CALC.Z(LP)+>MZ > AREA.Z THEN
    ;MZ => AREA.Z
  ;FI
  ;L.LINK.2 OF ELP^ => ELP
;OD
@BOX 6.1
;EQUIV.LIST.P => ELP
@BOX 7.1
;L.SPECS OF ELP^ & 1 => AREA.S
; 0 => AREA.T
@BOX 8.1
;GET.AREA(2+AREA.S,AREA.Z)
@BOX 9.1
;TL.EQUIV.POS(L.DISP OF L.ALT OF E.LP^)
@BOX 10.1
;DECLARE.ITEM(ELP)
@BOX 11.1
;IF L.LINK2 OF ELP^ => ELP /= NIL.LP
@BOX 13.1
;TL.DATA.AREA(0)
@BOX 12.1
@END
@TITLE FTN06.1.4(1,11)
@COL 1S-2T-3T-4R-9F
@COL 10R-11R
@ROW 3-10
@FLOW 1-2N-3F-4-9
@FLOW 2Y-10-3Y-11-4
@BOX 1.0
DECLARE ITEM(LP)
@BOX 2.0
SAVE USED CONSISTENTLY
IN AREA
@BOX 3.0
UPDATE AREA TYPE
INCONSISTENT TYPES USED IN AREA
@BOX 4.0
DECLARE ITEM TO MUTL
[FTN06.11]
@BOX 9.0
END
@BOX 10.0
FAULT
@BOX 11.0
FAULT
@BOX 1.1
;PROC DECLARE.ITEM(LP)
;$IN T,Z,ZU,LT
@BOX 2.1
;LP => F.L.PROP.G
;IF L.SPECS OF LP^ & 1 /= AREA.S
@BOX 3.1
;IF L.TYPE OF LP^ => LT = 5 THEN
    ;4 => T
;ELSE
    ;2 => T
;FI
;IF AREA.T ! T = 6
@BOX 4.1
; T !> AREA.T
; DECLARE.TL.ITEM(LP)
@BOX 9.1
;END
@BOX 10.1
;FAULT(84,1)
@BOX 11.1
;FAULT(85,1)
; 0 => T
@END
@TITLE FTN06.1.5(1,10)
@COL 2S-3R-4R-5T-6R-7R-9T-10R-11T-12F
@COL 13T-14R
@ROW 6-13
@FLOW 2-3-7-9NO(GRP ALREADY EQ)-10-11YES-4N-5NO-6-7
@FLOW 5YES(PREV EQ)-13NO-14-7
@FLOW 13YES-7
@FLOW 9YES-11NO-12
@BOX 2.0
ADD TO EQUIV LIST(EQUIV ENTRY PTR)
@BOX 3.0
CALCULATE EQUIVALENCED POSITION WITHIN ITEM:6.1.6:
CALCULATE EQUIVALENCE POSITION WITHIN AREA
@BOX 4.0
CALCULATE POSITION OF ITEM WITHIN AREA:6.1.6:
@BOX 5.0
HAS ITEMS POSITION PREVIOUSLY BEEN DETERMINED?
@BOX 6.0
SAVE POSITION OF ITEM
NOTE POSITION OF ITEM DETERMINED
ADD TO LIST OF ITEMS EQUIVALENCED
@BOX 7.0
MARK THIS ENTRY AS EQUIVALENCED
@BOX 9.0
INTERGROUP EQUIVALENCES PROCESSED?
@BOX 10.0
PROCESS EQUIVALENCE ITEMS IN
NEXT INTERGROUP
@BOX 11.0
ADVANCE TO NEXT ITEM IN EQUIV GROUP
ALL ITEMS PROCESSED IN GROUP?
@BOX 12.0
END
@BOX 13.0
ITEMS POSITION THE SAME
@BOX 14.0
FAULT
@BOX 2.1
;PROC ADD.TO.EQUIV.LIST(E.P)
;$IN AD, AREA.EQ.POS
;ADDR EQUIV.PROP ST.E.P
;$IN T
;ADDR LOCAL.PROP LP
@BOX 3.1
;EQ.LP.A OF E.P^ => LP
;ITEM.EQUIV.POS(E.P => ST.E.P) + L.DISP OF L.ALT OF LP^
    => AREA.EQ.POS
@BOX 7.1
;1 => EQ.FLAG OF EP^
@BOX 9.1
;IF EQ.FLAG OF IGR.LINK^ OF E.P^ /= 0
@BOX 10.1
;ADD.TO.EQUIV.LIST(IGR.LINK OF E.P^)
@BOX 11.1
;IF GR.LINK OF E.P^ => E.P /= ST.E.P
@BOX 12.1
;END
@BOX 4.1
;AREA.EQ.POS-ITEM.EQUIV.POS(EP) => T
@BOX 5.1
;EQ.LP.A OF E.P^=> LP
;IF L.SPECS OF LP^ & %4000 /= 0
@BOX 6.1
; %4000 ! > L.SPECS OF LP^
;T => L.DISP OF L.ALT OF LP^
;EQUIV.LIST.P => L.LINK2 OF LP^
;LP => EQUIV.LIST.P
@BOX 13.1
;IF L.DISP OF L.ALT OF LP^ = T
@BOX 14.1
;LP => F.L.PROP.G
;FAULT(88,1)
@END
@TITLE FTN06.1.6(1,10)
@COL 5R
@COL 2S-3T-4T-6T-7R-11T-8R-9R-10T-22R-23T-24T-25T-26R-12C
@COL 13N-14R-15R-16R-28R-29R-18F
@ROW 3-13
@ROW 6-14
@ROW 7-15
@ROW 5-11
@ROW 25-28
@FLOW 2-3NO-4NO-6NO-7-11N-8-9-10
@FLOW 4YES-14-18
@FLOW 6YES-15-18
@FLOW 10YES-11
@FLOW 11YES-16-18
@FLOW 10N-22-23N-24N-25N-26-12
@FLOW 23Y-12
@FLOW 24Y-28-18
@FLOW 25Y-29-18
@FLOW 3Y-5-23
@BOX 2.0
ITEMS.EQUIV.POS(EQUIV ENTRY^)
@BOX 3.0
NO DIMS SPECIFIED IN EQUIV
@BOX 4.0
ITEM SCALAR?
@BOX 6.0
NO OF DIMS DISAGREE IN
EQ AND ARRAY?
@BOX 7.0
SET POS = 0,MULT = 1
@BOX 8.0
CALC POS TO NEXT DIMENSION
@BOX 9.0
CALC MULT FOR NEXT DIMENSION
@BOX 10.0
ANY MORE EQ DIM?
@BOX 11.0
OUTSIDE BOUNDS?
@BOX 12.0
RESULT =
DISP * ELEMENTSIZE
@BOX 14.0
FAULT
@BOX 15.0
FAULT
@BOX 16.0
FAULT
@BOX 18.0
END
@BOX 5.0
SET POS = 0
@BOX 22.0
CALCULATE POSITION IN BYTES
@BOX 23.0
NO SUBSTRING
@BOX 24.0
NON CHARACTER TYPE?
@BOX 25.0
LOWER SPECIFIER OUTSIDE BOUNDS?
@BOX 26.0
ADD LOWER SPECIFIER TO POS
@BOX 28.0
FAULT
@BOX 29.0
FAULT
@BOX 2.1
;PROC ITEM.EQUIV.POS(EP)
;ADDR LOCAL.PROP LP
;$IN N,M,I,J,K,LB,UB,LT,LL,LS
;$IN32 P
;ADDR [$IN] A.D,E.D
;EQ.LP.A OF EP^ => LP => F.L.PROP.G
;L.TYPE OF LP^ => LT;L.LEN OF LP^ => LL
@BOX 3.1
;IF EQ.NO.DIM OF EP^ => N = 0
@BOX 4.1
;IF L.KIND OF LP^ /= 2
@BOX 6.1
;L.ARR.SPEC.P OF LP^ => AD
;IF AD^ [0] /= N
@BOX 7.1
;0 => P;1 => M;-1 => I => J
;EQ.SUBS OF EP^ => ED
@BOX 11.1
;IF E.D^ [1+>I] => K < AD^ [3+>J] => LB OR
                   K > AD^ [J+1] => UB
@BOX 8.1
;K - LB * M +> P
@BOX 9.1
;UB - LB + 1 *> M
@BOX 10.1
;IF 1 -> N > 0
@BOX 22.1
;IF LT /= 5 THEN
   ;PR.T[LL] *> P
;ELSE
   ; LL *> P
;FI
@BOX 23.1
;IF EQ.L.SS OF EP^ => LS = 0
@BOX 24.1
;IF LT /= 5
@BOX 25.1
;IF LS > LL
@BOX 26.1
;LS - 1  +> P
@BOX 5.1
;0 => P
@BOX 28.1
;FAULT(92,1)
@BOX 29.1
;FAULT(93,1)
@BOX 18.1
;0 => ITEM.EQUIV.POS
;END
@BOX 12.1
;P => ITEM.EQUIV.POS
;EXIT
@BOX 14.1
;FAULT(90,1)
@BOX 15.1
;FAULT(89,1)
@BOX 16.1
;FAULT(91,1)
@END
@TITLE FTN06.1.7(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
REPLACE.AS
@BOX 2.0
SAVE THE AS IF NOT DONE
SAVE THE START OF THE AR
REPLACE THE AS WITH THE NEW ONE
SAVE THE PROPS IF NOT DONE
REPLACE THE PROPS IF DIFFERENT
@BOX 3.0
END
@BOX 1.1
:: @@@ BCT 28-DEC-82 Start of new code
;PROC REPLACE.AS(NEW.AS,NEW.PROPS)
;$IN I
@BOX 2.1
;IF DUMP.AR = NIL.AR THEN
    ;MAKE.IN(END.AP.G+1,LOCAL.SPACE) => DUMP.AR
    ;FOR I < END.AP.G+1 DO AS[I] => DUMP.AR^[I] OD
    ;STAT.AP.G => SAVE.STAT.AP
;FI
;FOR I < SIZE(NEW.AS) DO
     NEW.AS^[I] => AS[I] OD
;IF DUMP.PR = NIL.PROPS THEN
    ;MAKE.PROPS(PROPS.I+1,LOCAL.SPACE) => DUMP.PR
    ;FOR I < PROPS.I+1 DO PROPS.T[I] => DUMP.PR^[I] OD
 FI
;IF CURRENT.PR /= NEW.PROPS THEN
    ; FOR I < SIZE(NEW.PROPS) DO
         NEW.PROPS^[I] => PROPS.T[I] OD
    ;NEW.PROPS => CURRENT.PR
 FI
@BOX 3.1
END
@END
@TITLE FTN06.1.8(1,11)
@COL 1S
@FLOW 1
@BOX 1.0
DECLARE ANY SAVED DATA INITIALISATIONS
@BOX 1.1
;BEGIN
;LITERAL/ADDR DATA.LIST NIL.DATA =
;$IN STK.STAT.NO
;STAT.NO => STK.STAT.NO
;8 => STAT.NO
;WHILE DATA.LIST.ROOT /= NIL.DATA DO
      REPLACE.AS(ARP OF DATA.LIST.ROOT^,PROPS.P OF DATA.LIST.ROOT^)
    ; 0 => STAT.AP.G
    ; DATA ()
    ; NEXT OF DATA.LIST.ROOT^ => DATA.LIST.ROOT
 OD
;STK.STAT.NO => STAT.NO
 END
@END
@TITLE FTN06.1.9(1,11)
@COL 1S
@FLOW 1
@BOX 1.0
DECLARE ANY SAVED FORMATS
@BOX 1.1
;BEGIN
;ADDR LABEL.PROP CURRENT.LAB
; $IN X,I
; ADDR [$IN] FMT.TABLE
; ADDR [$LO8] FMT.STRINGS
;LITERAL/ADDR FORMAT.LIST NIL.FORMAT =
;LITERAL/ADDR [$LO8] NIL.STRING =
;WHILE FORMAT.LIST.ROOT /= NIL.FORMAT DO
      F.LABEL OF FORMAT.LIST.ROOT^ => CURRENT.LAB
    ; TL.S.DECL (NIL.STRING,FMT.TABLE.EL.TYPE.L,-1)
    ; TL.S.DECL (NIL.STRING,%80,-1)
    ; MUTLN.G => X => S.TL.NAME OF CURRENT.LAB^ + 2 => MUTL.N.G
    ; TL.ASS(X,-1)
    ; F.TABLE OF FORMAT.LIST.ROOT^ => FMT.TABLE
    ; FOR I < F.BND OF FORMAT.LIST.ROOT^ DO
         TL.C.LIT.32(FMT.TABLE.EL.TYPE.L,FMT.TABLE^[I])
       ; TL.ASS.VALUE(0,1)
      OD
    ; TL.ASS.END ()
    ; TL.ASS(X+1,-1)
    ; IF F.STRINGS OF FORMAT.LIST.ROOT^ => FMT.STRINGS /= NIL.STRING THEN
         TL.C.LIT.S(%80,FMT.STRINGS)
        ;TL.ASS.VALUE(0,1) FI
    ; TL.ASS.END ()
    ; NEXT OF FORMAT.LIST.ROOT^ => FORMAT.LIST.ROOT
 OD
END
@END
@TITLE FTN06.1.10
@COL 1S
@FLOW 1
@BOX 1.0
DECLARE ANY SAVED ENTRIES
@BOX 1.1
;BEGIN
;LITERAL/ADDR ENTRY.LIST NIL.ENTRY =
;WHILE ENTRY.LIST.ROOT /= NIL.ENTRY DO
     ; REPLACE.AS(ARP OF ENTRY.LIST.ROOT^,E.PROPS OF ENTRY.LIST.ROOT^)
     ; STAT.AP.ENTRY OF ENTRY.LIST.ROOT^ => STAT.AP.G
     ; ENTRY ()
 OD
 END
@END
@TITLE FTN06.1.11(1,11)
@COL 1S
@FLOW 1
@BOX 1.0
REPLACE SAVED AS IF NECESSARY
@BOX 1.1
;BEGIN
;$IN I
;LITERAL/ADDR [$IN] NIL.AR =
;LITERAL/ADDR [PROPS] NIL.PROPS =
;IF DUMP.AR /= NIL.AR THEN
    SAVE.STAT.AP => STAT.AP.G
   ;FOR I < END.AP.G+1 DO DUMP.AR^[I] => AS[I] OD
 FI
;IF DUMP.PR /= NIL.PROPS THEN
    FOR I < PROPS.I+1 DO DUMP.PR^[I] => PROPS.T[I] OD
 FI
END
@END
@TITLE FTN06.2(1,11)
@COL 22T-23T-24R-25R
@COL 1S-2T-9R-3R-4T-5T-17T-18T-19N-20T-21R-27R-15T-6T-28R-16T-26R-7T-12R-8N
@COL 14F-13R-11R-10C
@ROW 5-14
@ROW 7-11
@ROW 22-21
@FLOW 1-2N-9-3-4N-5N-17N-18N-19-6
@FLOW 15N-6N-28-16N-26N-7N-12-8-4
@FLOW 18Y-11-10
@FLOW 17Y-20N-21-4
@FLOW 20Y-22N-23N-24-25-15
@FLOW 22Y-15
@FLOW 23Y-27-15
@FLOW 2Y-3
@FLOW 4Y-14
@FLOW 6Y-16Y-7Y-8
@FLOW 15Y-7
@FLOW 5Y-13-10
@BOX 1.0
CHECK SPECS(SPEC1(REFN),SPEC2(DEFN))
STATUS = 0 SPECS CONSISTANT
           1 = 0 INCONSISTENT
@BOX 2.0
RESULT TYPES AGREE?
@BOX 3.0
INIT INDEX TO SPECS
@BOX 4.0
GET NEXT ELEMENT FROM BOTH SPECS
END OF BOTH ARGUMENT LIST?
@BOX 5.0
END OF ONLY ONE ARGUMENT LIST?
@BOX 6.0
AGREEMENT IN TYPE
@BOX 7.0
AGREEMENT IN KIND
UPDATE SPEC1 IF NECESSARY
@BOX 9.0
FAULT
@BOX 10.0
END - FAULTY
@BOX 13.0
FAULT
@BOX 11.0
FAULT
@BOX 12.0
FAULT
@BOX 14.0
END - OK
@BOX 15.0
HOLLERITH OR FUNCTION?
@BOX 16.0
AGREEMENT IN PRECISION?
@BOX 17.0
BOTH ARGUMENTS NOT CHAR TYPE?
@BOX 18.0
ONLY ONE ARGUMENT CHAR TYPE?
@BOX 20.0
SPEC1 NOT A HOLLERITH ARGUMENT?
@BOX 21.0
UPDATE SPEC 1
@BOX 22.0
SPEC 1 NOT VALUE SIZED?
@BOX 23.0
SPEC 1 SIZE =< SPEC 2 SIZE?
@BOX 24.0
WARNING
@BOX 25.0
SET SPEC1 SIZE = MIN(SPEC 2 SIZE, 4)
@BOX 26.0
FAULT
@BOX 27.0
SIZE1 => SIZE2
@BOX 28.0
FAULT
@BOX 1.1
;PROC CHECK.SPECS(S1,S2)
;$IN I,A1,A2,AK1,AK2,T,T1,T2,L1,L2
@BOX 2.1
;IF S1^[0] = S2^[0] AND S1^[1] = S2^[1]
@BOX 3.1
;0 => I => F.I.G
@BOX 4.1
;1 +> F.I.G
;S1^[2+>I] => A1
;S2^[I] => A2
;IF A1 = %FF  =  A2
@BOX 5.1
;IF A1 = %FF OR A2 = %FF
@BOX 6.1
;IF T1 = T2
@BOX 7.1
;A1 & %F0 => AK1
;A2 & %F0 => AK2
;IF AK1 /= AK2 THEN
    ;IF [AK1 = %10 OR AK1 = %20 OR AK1 = %40] AND
            AK1 & AK2 /= 0 THEN
        ;AK1 => AK2
    ;ELSE
        ;IF AK2 = %10 OR AK2 = %20 OR AK2 = %40 THEN
            ;IF AK1 & AK2 /= 0 THEN
                ;AK2 => AK1
                ;A2=>S1^[I]
            ;FI
        ;FI
    ;FI
;FI
;IF AK1 = AK2
@BOX 9.1
;FAULT(108,4)
@BOX 10.1
;-1 => CHECK.SPECS
;EXIT
@BOX 11.1
;FAULT(98,%84)
@BOX 12.1
;FAULT(109,%84)
@BOX 14.1
;0 => CHECK.SPECS
;END
@BOX 13.1
;FAULT(97,4)
@BOX 15.1
;IF A1 & %F0 = %10 OR T1 = 7
@BOX 16.1
;IF L1 = L2
@BOX 17.1
;0 => T
;IF A1 & 7 => T1 = 5 THEN
   ; 1 +> T
;FI
;IF A2 & 7 => T2 = 5 THEN
   ; 1 +> T
;FI
;S1^[I + 1] => L1
;S2^[1 + I] => L2
;IF T = 0
@BOX 18.1
;IF T = 1
@BOX 20.1
;IF T1 /= 7
@BOX 21.1
;A2 => S1^[I]
;L2 => S1^[I + 1]
@BOX 22.1
;IF L1 & %10 = 0
@BOX 23.1
;IF L1 & %F =< L2
@BOX 24.1
;FAULT(164, 6)
@BOX 25.1
;IF L2 > 4 THEN
   ;4 => L1
;ELSE
   ;L2 => L1
;FI
;L1 => S1^[I+1]
@BOX 26.1
;FAULT(111,%84)
@BOX 27.1
;L2 => L1
@BOX 28.1
;FAULT(109,%84)
@END
@TITLE FTN06.3(1,10)
@COL 1S-3T-2T-25R-4T-5R-7T-8T-9T-12T-13T-14R-15T-16R-17R-18T-19R
@COL 26R-20F-10T-11R-21R-23R-24R
@ROW 4-26
@ROW 13-23
@ROW 16-24
@FLOW 1-3N-2N-25-4N-5-7N-8N-9N-12N-13N-14-15N-16-17-18N-19-3
@FLOW 3Y-26-20
@FLOW 2Y-19
@FLOW 4Y-19
@FLOW 7Y-19
@FLOW 8Y-18
@FLOW 9Y-10N-11-12
@FLOW 10Y-21-26
@FLOW 12Y-23-17
@FLOW 13Y-21
@FLOW 15Y-24-17
@FLOW 18Y-7
@BOX 1.0
PROCESS DUMMY ARGUMENTS
@BOX 2.0
ARGUMENT IN A PREVIOUS ENTRY LIST?
@BOX 3.0
NO MORE DUMMY ARGUMENTS?
@BOX 25.0
SET MUTL TYPE IF NOT ALREADY SET
AND KIND OF ARGUMENT KNOWN
GET FIRST DIMENSION
@BOX 4.0
NOT AN ADJUSTABLE ARRAY?
@BOX 5.0
NOTE INDEX MODE IS INTEGER 32
SAVE CURRENT ANAL RECORD
IF FIRST ADJ ARRAY
RECOVER ANALYSIS RECORD
@BOX 26.0
RECOVER ANAL RECORD IF
SAVED
@BOX 7.0
LAST DIM OF ASSUMED SIZE ARRAY?
@BOX 8.0
DIMENSION NOT ADJUSTABLE
@BOX 9.0
LOWER BOUND ADJUSTABLE
@BOX 10.0
REDUCE EXPR:11.2:
INVALID OR NOT AN INTEGER EXPR?
@BOX 11.0
DECL VARIABLE FOR LOWER BOUND
CODE EXPR IN A:11.3:
PLANT CONVERT IF REQUIRED
PLANT A=> L.B.VAR
UPDATE PROPS
@BOX 12.0
UPPER BOUND NOT ADJUSTABLE?
@BOX 13.0
REDUCE EXPR:11.2:
INVALID OR NOT AN INTEGER EXPR?
@BOX 14.0
CODE EXPR IN A:11.3:
PLANT CONVERT TO INDEX SIZE IF NECESSARY
@BOX 15.0
LOWER BOUND A CONSTANT
@BOX 16.0
PLANT A-LB,A+1
@BOX 17.0
DECL VARIABLE FOR DIM BOUND
UPDATE PROPS
PLANT A=> DIM.BOUND VARIABLE
RESET A USE
@BOX 18.0
GET NEXT DIM
NO MORE DIM
@BOX 19.0
GET NEXT DUMMY ARGUMENT
@BOX 20.0
END
@BOX 21.0
FAULT
@BOX 23.0
PLANT A = UB.CONST+1
PLANT A - LB VAR
@BOX 24.0
IF LB NOT 1
PLANT A - LB.CONST+1
@BOX 1.1
;PROC PROCESS.DUMMY.ARGUMENTS(LP)
;LITERAL/ADDR LOCAL.PROP NIL.LP =
;LITERAL/ADDR[$LO8] NIL.STR=
;$IN LS,DMP,Z,DBITS,I,N,J,LBN,T
;ADDR [$IN] DAS,ARR,AS.D
;ADDR [PROPS] PR.T.D, PROPS.T.D
;0=>DMP
@BOX 2.1
;IF L.LINK2 OF LP^ /= NIL.LP
@BOX 3.1
;IF LP = NIL.LP
@BOX 25.1
;IF L.SPECS OF LP^ => LS & %2000 = 0 THEN
   ;0 => T
   ;IF LS & 2 /= 0 THEN %24 => T
    ;ELSE IF L.KIND OF LP^ = 2 THEN
        ;MUTL.TYPE(L.TYPE OF LP^, L.LEN OF LP^) ! 3 =>T
    ;FI FI
   ;IF T /= 0 THEN
       ;TL.SET.TYPE(L.TL.NAME OF LP^, T)
       ;%2000 !> L.SPECS OF LP^
;FI FI
@BOX 4.1
;IF LS & %8000 = 0
@BOX 5.1
;IF DMP = 0 THEN
  ;MAKE.IN(END.AP.G+1,LOCAL.SPACE)=>AS.D
  ;FOR I < END.AP.G+1 DO AS[I] => AS.D^[I] OD
   ;MAKE.PROPS(PROPS.I+1,LOCAL.SPACE)=>PROPS.T.D
   ;FOR I < PROPS.I+1 DO PROPS.T[I] => PROPS.T.D^[I] OD
  ;1=>DMP  FI
;L.AS.DUMP OF LALT OF LP^ => DAS
;SIZE(DAS) => Z
;WHILE 1 -> Z >= 0 DO
    ;DAS^[Z] => AS[Z] OD
; L.PROPS.T.DUMP OF LALT OF LP^ => PR.T.D
;SIZE(PR.T.D) => Z
;WHILE 1 -> Z >= 0 DO PR.T.D^[Z] => PROPS.T[Z] OD
;L.ARR.SPEC.P OF LP^ => ARR
;ARR^ [0] => N
;ARR^ [1] => D.BITS
;%80(7) !> ARR^[1]
;2 => I
@BOX 26.1
;IF DMP /= 0 THEN
  ;FOR I < END.AP.G + 1 DO AS.D^[I] => AS[I] OD
   ;FOR I < PROPS.I + 1 DO PROPS.T.D^[I] => PROPS.T[I] OD
;FI
@BOX 7.1
;IF N = 1 AND LS & %100 /= 0
@BOX 8.1
;IF D.BITS ->> 2 => D.BITS & 3 = 0
@BOX 9.1
;IF D.BITS & 1 /= 0
@BOX 10.1
;IF REDUCE.EXPR(ARR^ [I] => T) & %F /= 3
@BOX 11.1
;CODE.EXPR(T,%22)
;V.DECL(3, IND.ACC.Z.G, 0) => LB.N
;TL.PL(%20,LB.N)
;IF AS[T] ->> 5 & 7 /= IND.ACC.Z.G THEN
   ;SET.A.TYPE(%13, IND.ACC.Z.G)
;FI
;-1 => A.AP.G
;LB.N => ARR^ [I]
@BOX 12.1
;IF D.BITS & 2 = 0
@BOX 13.1
;IF REDUCE.EXPR(ARR^ [I+1] => T) & %F /= 3
@BOX 14.1
;CODE.EXPR(T,%22)
;IF AS[T] ->> 5 & 7 /= IND.ACC.Z.G THEN
   ;SET.A.TYPE(%13,IND.ACC.Z.G)
;FI
@BOX 15.1
;IF D.BITS & 1 = 0
@BOX 16.1
;TL.PL(%29,LBN)
;TL.C.LIT.16(%84,1)
;TL.PL(%28,0)
@BOX 17.1
;TL.PL(%20, VDECL(3, IND.ACC.Z.G, 0) => ARR^[I+2])
;-1 =>  A.AP.G
@BOX 18.1
;3 +> I
;IF 1 -> N > 0
@BOX 19.1
;L.LINK.1 OF LP^ => LP
@BOX 20.1
;END
@BOX 21.1
;LP => F.L.PROP.G
;FAULT(87,1)
@BOX 23.1
;SET.A.TYPE(3, IND.ACC.Z.G)
;TL.C.LIT.32(I.ACC.T.L,ARR^ [I+1] + 1)
;TL.PL(%22,0)
;TL.PL(%29,LBN)
@BOX 24.1
;IF ARR^[I]-1=>T /= 0 THEN
;TL.C.LIT.32(I.ACC.T.L,T)
;TL.PL(%29,0)
;FI
@END
@TITLE FTN06.4(1,11)
@COL 15R-16C-9R-10R
@COL 1S-12T-13T-14R-2R-3R-4T-5T-6R-7R-8F
@COL 11R
@ROW 9-6-11
@ROW 15-14
@FLOW 1-12N-13N-14-2-3-4N-5N-6-7-8
@FLOW 4Y-11-7
@FLOW 5Y-9-10-7
@FLOW 12Y-2
@FLOW 13Y-15-16
@BOX 1.0
DECLARE.PROC.SPEC(ARG.SPEC^,KIND,SYMB.NAME)PROC TL NAME
@BOX 2.0
CALL TL.PROC.SPEC
@BOX 3.0
SCAN ARG SPEC
DECLARE MUTL PARAM FOR EACH DUMMY ARGUMENT
WHICH IS NOT AN ALTERNATE RETURN ARGUMENT
IN ADDITION DECLARE A PARAM
FOR LENGTH OF CHARACTER ARGUMENTS
@BOX 4.0
SUBROUTINE?
@BOX 5.0
CHAR FUNCTION?
@BOX 6.0
DECLARE PROC WITH RESULT
@BOX 7.0
ALLOCATE MUTL NAME FOR
PROC SPEC
@BOX 9.0
ALLOCATE MUTL PARAMS FOR
REFN TO RESULT CHAR VARIABLE
AND ITS LENGTH
@BOX 10.0
DECLARE PROC WITH NO RESULT
@BOX 11.0
DECLARE INT RESULT
FOR POSSIBLE ALTERNATE RETURN
VALUE
@BOX 8.0
END
@BOX 12.0
MUTL NAME ALREADY DECLARED
OR SPEC OF PROC VARIABLE?
@BOX 13.0
NO MORE PRE-DECLARED
EMPTY PROCS AVAILABLE?
@BOX 14.0
SET KIND
@BOX 15.0
FAULT
@BOX 16.0
ABORT COMPILE
@BOX 1.1
;PROC DECLARE.PROC.SPEC(ARG,K,N)
;$IN I,J,A
@BOX 2.1
;TL.PROC.SPEC(N,K)
@BOX 3.1
;0 => I
;WHILE ARG^[2 +> I] => A /= %FF DO
    ;IF A & %17 /= 6 THEN
        ;IF A & 7 = 5 THEN
            ;TL.PROC.PARAM(ARG.CH.T,0)
            ;TL.PROC.PARAM(%44,0)
        ;ELSE
            ;TL.PROC.PARAM(D.ARG.TYPE.L,0)
        ;FI
    ;FI
;OD
@BOX 4.1
;IF ARG^[0] => I = 7
@BOX 5.1
;IF I & 7 = 5
@BOX 6.1
;TL.PROC.RESULT(MUTL.TYPE(I, ARG^[1]))
@BOX 7.1
;IF K = %10 THEN
    ;MUTL.N.G => DECLARE.PROC.SPEC
       + 1 =>MUTL.N.G
;ELSE
   ;K & %FFF => DECLARE.PROC.SPEC
;FI
@BOX 8.1
;END
@BOX 9.1
;TL.PROC.PARAM(ARG.CH.T,0)
;TL.PROC.PARAM(%44,0)
@BOX 10.1
;TL.PROC.RESULT(0)
@BOX 11.1
;TL.PROC.RESULT(%44)
@BOX 12.1
; IF K & %1010 /= 0
@BOX 13.1
; IF 1 -> PSPEC.CNT < 0
@BOX 14.1
; P.SPECN.G ! %1000 ! (K& %C000) => K
; 1 +> PSPECN.G
@BOX 15.1
; FAULT(130,6)
@BOX 16.1
; -> ABORT.COMPILE
@END
@TITLE FTN06.5(1,11)
@COL 21R-27R
@COL 1S-9T-7T-20T-26T-2R-30T-6R-3R-4F
@COL 10T-11R-25R-31R
@ROW 6-31
@FLOW 1-9N-7N-20N-26N-2-30N-6-3-4
@FLOW 7Y-4
@FLOW 30Y-31-3
@FLOW 9Y-10N-11-25-4
@FLOW 26Y-27-4
@FLOW 10Y-4
@FLOW 20Y-21-4
@ROW 7-10
@ROW 6-21
@BOX 1.0
CHECK.IMPLICIT.DECL(LOCAL PROP^)
@BOX 2.0
NOTE IF SAVED
@BOX 6.0
GET AREA Z:6.9:
GET AREA :6.8:
@BOX 7.0
NOT AN IMPLICIT DECLARATION
@BOX 3.0
DECL VARIABLE TO MUTL
SELECT DATA AREA 0
@BOX 4.0
END
@BOX 9.0
DUMMY ARGUMENT
@BOX 10.0
KIND DEFINED
@BOX 11.0
SET KIND TO SCALAR
@BOX 20.0
ADJUSTABLE ARRAY
@BOX 21.0
FAULT
@BOX 25.0
SET MUTL TYPE FOR ARGUMENT
@BOX 26.0
CHARACTER ITEM OF ASSUMED
LENGTH?
@BOX 27.0
FAULT
'ILLEGAL USE OF (*)
ON name'
@BOX 30.0
ON STACK DECLARATIONS REQUESTED
AND ITEM NOT IN A DATA STATEMENT
AND NOT SAVED
@BOX 31.0
NOTE DECLARED
ON STACK IN PROPS
@BOX 1.1
;PROC CHECK.IMPLICIT.DECL(LP)
;$IN LK,LS,LT,SAVED

@BOX 2.1
;LS & 1 ! ALL.SAVE.G => SAVED
@BOX 3.1
;DECLARE.TL.ITEM(LP)
;TL.DATA.AREA(0)
@BOX 4.1
;END
@BOX 6.1
;GET.AREA(SAVED,CALC.Z(LP))
@BOX 7.1
;IF L.KIND OF LP^ => LK /= 0 AND [LK /= 2 OR L.TL.NAME OF LP^ /= 0]
@BOX 9.1
; 0 => CHECK.IMPLICIT.DECL
;L.TYPE OF LP^ => LT
;IF L.SPECS OF LP^ => LS & %200 /= 0
@BOX 10.1
;IF L.KIND OF LP^ /= 0
@BOX 11.1
;1 => L.KIND OF LP^
;%2000 !> L.SPECS OF LP^
@BOX 20.1
; LP => F.L.PROP.G
;IF LS & %8010 /= 0
@BOX 21.1
;1=>CHECK.IMPLICIT.DECL
;FAULT(116,1)
@BOX 25.1
;IF LT = 5 THEN
   ;ARG.CH.T => LT
;ELSE
   ;MUTL.TYPE(LT, L.LEN OF L.P^) ! 1 => LT
;FI
;TL.SET.TYPE(L.TL.NAME OF LP^,LT)
@BOX 26.1
;IF L.LEN OF LP^ = -1
@BOX 27.1
;1=>CHECK.IMPLICIT.DECL
;FAULT(123,1)
@BOX 30.1
;IF INFORM.LINE.G & ON.STACK.BIT.L /= 0 AND
     STAT.NO /= 8 AND SAVED = 0
@BOX 31.1
; %20 !> L.SPECS OF LP^
@END
@TITLE FTN06.6(1,6)
@COL 1S-2T-3R-9T-10R-4T-5R-11F
@COL 12R
@ROW 3-12
@FLOW 1-2N-3-9
@FLOW 2Y-12-9N-10-4N-5-11
@FLOW 9Y-11
@FLOW 4Y-11
@BOX 1.0
CALCULATE ITEM SIZE(LP) SIZE
RESULT
0-IF ARITHMETIC SCALAR OR
NO OF ELEMENTS-IF ARITHMETIC ARRAY
SIZE IN BYTES-IF CHARACTER
@BOX 2.0
SCALAR
@BOX 12.0
SET KIND TO SCALAR
SET SIZE
@BOX 3.0
CALCULATE NO OF ELEMENTS
IN ARRAY
@BOX 4.0
SCALAR?
@BOX 5.0
NOTE IN PROPS
PRECISION NECESSARY TO EVALUATE INDEX
@BOX 9.0
NOT
CHARACTER
@BOX 10.0
MULT SIZE BY CHARACTER LENGTH
@BOX 11.0
END
@BOX 1.1
;PROC CALCULATE.ITEM.SIZE(LP)
;$IN LT,I,K,J
;$IN32 Z
;ADDR [$IN] ARR
;L.TYPE OF LP^ => LT
@BOX 2.1
;IF L.KIND OF LP^ => K /= 2
@BOX 3.1
;L.ARR.SPEC.P OF LP^ => ARR
;ARR^ [0] => I
;1 => J
;1 => Z
;WHILE 1 -> I >= 0 DO
   ;ARR^[3+>J]*>Z
;OD
@BOX 4.1
;IF K /= 2
@BOX 5.1
;1 => K
;IF Z & %FFFF8000 /= 0 THEN
   ;2 => K
;FI
;K <<- 30 !> ARR^[1]
@BOX 11.1
;Z => CALCULATE.ITEM.SIZE
;END
@BOX 12.1
;1 => L.KIND OF LP^
;IF LT=5 THEN
   ;1=>Z
;ELSE
   ;0=>Z
;FI
@BOX 9.1
;IF LT /= 5
@BOX 10.1
;L.LEN OF LP^ *> Z
@END
@TITLE FTN06.8(1,11)
@COL 1S-2R-11T-12T-13R-4R-10T-6R-7F
@COL 9R
@ROW 10-9
@FLOW 1-2-11N-12N-13-4-10N-6-7
@FLOW 10Y-9-6
@FLOW 11Y-4
@FLOW 12Y-10
@BOX 1.0
GET.AREA(AREA.TYPE,SIZE)AREA.NO
AREA.TYPE
  BIT 0 = 1 SAVED
  BIT 1 = 1 EQUIVALENCED
SIZE IN BYTES
@BOX 2.0
ROUND UP SIZE
@BOX 4.0
SET AREA
@BOX 6.0
SELECT DATA AREA
NOTE AREA TYPE
@BOX 9.0
MAP NEW AREA TO IT
@BOX 7.0
END
@BOX 10.0
EQUIVALENCING REQUIRED
OR LAST AREA EQUIVALENCED?
@BOX 11.0
IMPLICIT MAPPING?
@BOX 12.0
SPACE AVAILABLE?
@BOX 13.0
FAULT
@BOX 1.1
;PROC GET.AREA(TYP,Z)
;$IN T,T2
@BOX 2.1
; Z + SU.SIZE.L - 1 & ROUNDING.MASK.L => Z
@BOX 4.1
;0 => T  ::jae 12/30
@BOX 9.1
;TL.LOAD(SEG.TBL[T],GET.AREA)  ::jae 12/30
@BOX 6.1
;TL.DATA.AREA(GET.AREA)
;TYP => L.GET.AREA.TYP
@BOX 7.1
;END
@BOX 10.1
;AREA.TBL[T] => GET.AREA  ::jae 12/30
;IF TYP > 1
    OR L.GET.AREA.TYP > 1
@BOX 11.1
;IF SEG.TBL[2] = 0
@BOX 12.1
;IF Z->SEG.Z.TBL[2=>T] >= 0
@BOX 13.1
;FAULT(136,6)
;0=>SEG.Z.TBL[2]
@END
@TITLE FTN06.9(1,10)
@COL 1S-2R-3T-7R-6R-8R-10F
@FLOW 1-2-3N-7-6-8-10
@FLOW 3Y-6
@BOX 1.0
CALCULATE SIZE IN BYTES(LP)Z
@BOX 2.0
CALCULATE MUTL SIZE : 6.7
IN Z
@BOX 3.0
Z NOT SCALAR?
@BOX 6.0
CALCULATE STORAGE REQUIRED
@BOX 8.0
SCALE TO BYTES
@BOX 10.0
END
@BOX 7.0
SET Z=1
@BOX 1.1
;PROC CALC.Z(LP)
;$IN32 Z
;$IN LT
@BOX 2.1
;L.TYPE OF LP^ => LT
;CALCULATE.ITEM.SIZE(LP)=>Z
@BOX 3.1
;IF Z /= 0
@BOX 6.1
;IF LT /= 5 THEN
   ;PR.T[L.LEN OF LP^] => CALC.Z
;ELSE
   ;1 => CALC.Z
;FI
@BOX 8.1
;Z *> CALC.Z
@BOX 10.1
;END
@BOX 7.1
;1 => Z
@END
@TITLE FTN06.10(1,6)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
GET.SEG
@BOX 2.0
SEARCH TABLE FOR NEXT SEG
NOTE USED
@BOX 3.0
END
@BOX 1.1
;PROC GET.SEG
@BOX 2.1
;IF MUTL.SEG.N.G >= 31 THEN
   ;FAULT(131,6)
   ;->ABORT.COMPILE
FI
; WHILE SEG.INFO[1+>MUTL.SEG.N.G] /= 0 DO OD
; 1 !> SEG.INFO[MUTL.SEG.N.G=>GET.SEG]
@BOX 3.1
END
@END
@TITLE FTN06.11(1,11)
@COL 1S-2R-3R-8R-9R-10F
@FLOW 1-2-3-8-9-10
@BOX 1.0
DECLARE.TL.ITEM (LP)
@BOX 2.0
CALCULATE DIMENSION
OF TL ITEM
@BOX 3.0
GET MUTL TYPE
@BOX 8.0
DECLARE TO MUTL
@BOX 9.0
UPDATE ITEM PROPERTIES
DECLARE BOUNDS TO MUTL
@BOX 10.0
END
@BOX 1.1
;PROC DECLARE.TL.ITEM (LP)
;ADDR Z
;$IN T
@BOX 2.1
;CALCULATE.ITEM.SIZE (LP) => Z
@BOX 3.1
;MUTL.TYPE (L.TYPE OF LP^, L.LEN OF LP^) => T
@BOX 8.1
;TL.S.DECL (NAME OF L.NAME OF LP^, T, Z)
@BOX 9.1
;MUTL.N.G => L.TL.NAME OF LP^ + 1 => MUTL.N.G
;%2000 !> LSPECS OF LP^
;DECLARE.TL.BOUNDS(LP)
@BOX 10.1
;END
@END
@TITLE FTN06.12(1,11)
@COL 1S-2T-3R-4R-5R-6F
@FLOW 1-2static-3-4-5-6
@FLOW 2not static-4
@BOX 1.0
V.DECL (TYPE, PRECISION, DIM)
TYPE:
  bits 0-7
      0-5 FORTRAN types
        6 bounded character pointer
  bit    8
      static allocation required
@BOX 2.0
ALLOCATION?
@BOX 3.0
CALCULATE STORAGE TO BE ALLOCATED;
GET AREA
@BOX 4.0
CALCULATE MUTL TYPE
@BOX 5.0
DECLARE VARIABLE TO MUTL
@BOX 6.0
END
@BOX 1.1
;PROC V.DECL (T, PR, DIM)
;LITERAL/ADDR[$LO8] NIL.STR =
;$IN Z, MT
@BOX 2.1
;IF T & %100 = 0
@BOX 3.1
;IF T /= 5
    THEN PR.T[PR] => Z
    ELSE 1 => Z
 FI
;IF DIM /= 0 THEN DIM *> Z FI
@BOX 4.1
;MUTL.TYPE (T & 7, PR) => MT
@BOX 5.1
;TL.S.DECL (NIL.STR, MT, DIM)
;MUTL.N.G => V.DECL + 1 => MUTL.N.G
@BOX 6.1
;END
@END
@TITLE FTN06.13(1,11)
@COL 1S-2T-3R-4R-5F
@COL 6R
@ROW 3-6
@FLOW 1-2other-3-4-5
@FLOW 2complex or character-6-4
@BOX 1.0
MUTL.TYPE (TYPE, PRECISION) MUTL.TYPE
TYPE:
      0-5 FORTRAN types
        6 bounded character pointer
PRECISION:
      0-4 FORTRAN precision:  1,2,4,8,16 bytes
        5 unbounded pointer
        6 bounded pointer
@BOX 2.0
FORTRAN TYPE?
@BOX 3.0
SET MUTL SIZE
@BOX 4.0
CREATE MUTL TYPE
@BOX 5.0
END
@BOX 6.0
SET MUTL SIZE TO ZERO
END
@BOX 1.1
;PROC MUTL.TYPE(T,PR)
@BOX 2.1
;IF T=2 OR T=5
@BOX 3.1
;PR.T[PR] - 1 <<- 2 => MUTL.TYPE
@BOX 4.1
;MODE[T] !> MUTL.TYPE
@BOX 5.1
;END
@BOX 6.1
;0 => MUTL.TYPE
@END
@TITLE FTN06.14(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
::CV
DECLARE.TL.BOUNDS
@BOX 2.0
::CV
PROCESS ARRAY SPEC
@BOX 3.0
::CV
END
@BOX 1.1
::CV new routine added
;PROC DECLARE.TL.BOUNDS (LP)
;ADDR [$IN] ARR
;$IN [14] BNDS
;$IN I,J,K,Z
@BOX 2.1
;IF L.KIND OF LP^ /= 2 THEN EXIT FI
;L.ARR.SPEC.P OF LP^ => ARR
;ARR^[0] => Z
;1 => J
;0 => K
;FOR I < Z DO
  ;ARR^[1+>J] => BNDS[K]
  ;ARR^[1+>J] => BNDS[1+K]
  ;1 +> J
  ;2 +> K
;OD
;TL.BOUNDS (L.TL.NAME OF LP^, PART(^BNDS,0,K-1))
@BOX 3.1
;END
::CV end added routine
@END

