@X @~
~L3 COUK1247
80
~V7 56 2 -5
~D10
~H                    MUSS
~
~
~D10
~H             FTN081
~D10
~MMANCHESTER UNIVERSITY  -  CONFIDENTIAL~
~
~
                                                            ISSUE 10~
~V9 -1
~P
~V9 1
~YFTN081
~M~OFORTRAN 77 COMPILER IMPLEMENTATION DESCRIPTION
~S1~M~OSection 8~
~S1~OSection 8. Control Statements
~S1~O1.1 General Description
~BThis section performs the semantics for the Fortran Control Statements
GO TO, computed GO TO, assigned GO TO, arithmetic IF, logical IF, Block
IF, ELSE IF, ELSE, END IF, DO, CONTINUE, STOP, PAUSE, END, CALL and
RETURN. Also included in this section are procedures for manipulating
and checking label definitions and references for inconsistant use
and violation of the block structure.
~BThe semantic routines in this section perform various semantic checks
and maintain tables for labels, Nesting of Block Structures and Do loops.
The routines cause code to be planted to perform the Control Statements.
~S~O1.2 Non Standard Features
~BNone.
~S1~O2. Interfaces
~S1~O2.1 Section Interfaces Used
   Section 1 : (Configuration Section)~
   Section 2 : (Statement Driver)~
   Section 4 : (Syntax Analysis)~
   Section 6 : (Specification Part Declrations)~
   Section 7 : (Assignment Statement Processing)~
   Section 11: (Expression Evaluation)~
   Section 12: (Property List Management)~
   Section 13: (Fault Monitoring)~
~S1~O2.2 Section Interfaces
Exported Scalars:~
   DO.PTR.G~
   CUR.NEST.LEV.G~
   CUR.BLOCK.NO.G~
   ASS.GOTO.LOOP.NAME.G~
   ASS.GOTO.VEC.NAME.G~
   JUMPED.G~
Exported Vectors:~
   NEST.TBL~
   DO.T~
Exported Procedures:~
   GO.TO~
   COMP.GO.TO~
   ASS.GO.TO~
   ARITH.IF~
   LOG.IF~
   BLOCK.IF~
   ELSE.IF~
   F.ELSE~
   END.IF~
   F.DO~
   F.CONTINUE~
   F.STOPAUSE~
   F.END~
   CALL~
   RETURN~
   PLANT.BRANCH~
   PROCESS.STAT.REF~
   PROCESS.STAT.LABEL~
   DO.LABEL~
~S1~O3. Implementation
~S1~O3.1 Outline of Operation
~S1~O3.1.1 GOTO()
~BThis performs the semantics for the GOTO statement. A check is made
on the next statement, following the GOTO, to see if it has a label,
and a note is made. The semantic routine for planting
code for branches is called.
~S1~O3.1.1.1 Code Planted
~BSEG -> label.
~S1~O3.1.2 COMP GO TO()
~BThis performs the semantics for the computed GO TO statement.
A vector of labels is declared to hold the
branches and then the expression is evaluated to produce an integer
in the 'B' register. Code is then planted to check that B is in
range and perform a switch using
the vector and the integer in the register. Following the code
planting, each label in the list is processed using the 'PROCESS
STAT REF' procedure, and the index for each label is added to the
vector.~
~S1~O3.1.2.1 Code Planted
~3
~Q 12
~
~
                        B = index~
                        Retain B in use after next instruction~
                        B COMP 0~
                        -> label IF =<~
                        Retain B in use after next instruction~
                        B COMP vector bound~
                        -> label IF >~
                        D = switch vector~
                        SEL EL~
                        SEG -> D[]~
          label:~
~0
~S1~O3.1.3 ASS GO TO()
~BThis performs the semantics for the assigned GO TO statement. As
with the GO TO statement a check is made, to see if the next statement
is labelled and a note is made. When the optional label list
is present the compiler can
perform checks to ensure that each label is being correctly used (so
as not to jump into nested loop or block structures) and can plant
code to check at run-time if an assigned label is in the list.
Two vectors are created for the list of permitted labels.
The first contains the internal identifiers of the labels, and the
second contains the code addresses of the labels.  Code is
planted to check if the label in the assigned variable is in the
first vector, if it is control is transfered via the corresponding
element in the second vector.
~Q 21
~S1~O3.1.3.1 Code Planted
~3
~
~M       TL.CV.CYCLE (loop.var,0,2)~
~N       TL.CV.LIMIT(BOUND of label vector -1)~
~N       D = REF label identifier vector
~N       B = Loop.var
~N       SEL EL
~N       AMODE = INTEGER~
~N       A = D[]
~N       A COMP variable
~N       IF A /= 0, -> LOOP
~N       D = REF label address vector
~N       B = Loop.var
~N       SEL EL
~N       -> D[]
~NLOOP : TL.REPEAT()~
~N       ENTER TRAP(8,111)
~0
~S1~O3.1.4 ARITH IF()
~BThis performs the semantics for the arithmetic IF statement. Initially
the arithmetic expression is evaluated and code is planted to compare
the result with zero. The labels in the statement are then processed
to ensure that an optimum number of tests are planted by comparing
the three labels in the statement with each other and with the next
statement label. Firstly all the labels are checked for validity.
~BThere are 15 possible combinations of the four labels arranged three
at a time. To evaluate and represent which of the 15 is present in
the particular statement four binary bits are used. Each of the bits
represents four relationships between some of the labels, but because
there are six possible relationships some of the combinations will
fail to be represented. These ambiguous cases are picked out individually
and the index bits changed accordingly. When this index value from zero
to fifteen has been calculated a check is made to ensure that the next
statement following this arithmetic can be reached in the
flow of control (i.e. it must have a label).
~BThe index is used to extract the appropriate code for each of the
15 cases from a code vector, and the code is planted.
~BThe 15 possible combinations, and the index generated for them is
shown below, where F, S, T and N represent the First, Second, Third
and Next statement labels respectively.~
~3
~
      F,S,T,N(0)    F=N,S,T(1)    F,S=N,T(7)    F,S,T=N(4)~
      F=S,T,N(2)    F=S=N,T(3)    F=S,T=N(6)~
      F,S=T,N(8)    F=N,S=T(9)    F,S=T=N(12)~
      T=F,S,N(11)   T=F=N,S(5)    T=F,S=N(13)~
      F=S=T,N(10)   F=S=T=N(15)                 (14 is not used)~
~0
~S1~O3.1.4.1 Code Planting~
~BFollowing the coding of the arithmetic expression.~
~
~MA COMP 0  is planted~
~
followed by a sequence of branches chosen from the index as
follows:~
~3
~Q 43
~
~OIndex~O               ~OCode~O~
~
  0                 -> First label IF <~
                    -> Third label IF >~
                    SEG -> Second label~
~
  1                 -> Second label IF =~
                    -> Third label IF >~
~
  2                 -> First label IF =<~
                    SEG -> Third label~
~
  3                 -> Third label , IF>~
~
  4                 -> First label , IF <~
                    -> Second label , IF =~
~
  5                 -> Second label , IF =~
~
  6                 -> First label , IF =<~
~
  7                 -> First label , IF <~
                    -> Third label , IF >~
~
  8                 -> Second label , IF >=~
                    SEG -> First label~
~
  9                 -> Second label , IF >=~
~
 10                 SEG -> First label~
~
 11                 -> First label , IF /=~
                    SEG -> Second label~
~
 12                 -> First label , IF <~
~
 13                 -> First label , IF /=~
~
 14                 Not used~
~
 15                 No code planted~
~0
~S1~O3.1.5 LOG IF()
~BThis performs the semantics for the logical IF statement.
The logical expression is first coded, then SYNTAX.CHECK is
called to recognise the conditionally executed statement, and a check
is made to ensure that the statement is permitted in a LOGICAL.IF.
If the expression was valid the code planted depends on whether the
result of the expression to be tested is in the 'A' register or the
'T' bits. If the result is in the 'T' bits a branch can be planted
directly, if the result is in the one bit mode 'A' register then
a comparison to set the 'T' bits must be planted.
~BAn optimisation is made if the statement contained in the
logical IF is a GO TO statement. The test and the branch can be
made in one order. A check is made to ensure the next statement is
labelled. If the statement in the logical IF is not a GO TO then
a jump around the statement is planted.~
~S1~O3.1.5.1 Code Planted
~BThere are four possible code sequences planted for a logical IF
statement depending on the test and the statement involved:~
~3
~
    a)  Result of test in 'T' bits and a GO TO.~
                -> label, IF test~
~
    b)  Result of test in 'T' bits and not a GO TO.~
                -> Next stat, IF ~Onot~O test~
~X{\ }#
                     {statement code}~
                Next stat:~
~
    c)  Result of test in 'A' and a GO TO.~
                A COMP 1~
                -> label, IF =~
~
    d)  Result of test in 'A' and not a GO TO.~
                A COMP 0~
                -> Next stat, IF =~
                     {statement code}~
~0
~X{{ }}
                Next stat:~
~S1~O3.1.6 BLOCK IF ()
~BThis performs the semantics for the Block IF statement. A check
is made to ensure this statement is not part of a logical IF, and
then the block number and nesting level are incremented and the block
nesting table entry for this block is initialised. The block IF
is then coded using the routine CODE IF().
~S1~O3.1.6.1 Code Planted
~BThe code planted for the parts of the block structure is as follows:~
~3
~Q 19
~
                        evaluate condition~
IF  THEN                A COMP .....~
                        -> else IF ....     ---~
                                               |~
                                               |~
                                               |~
ELSE  IF  THEN          SEG -> end if      <---     ---~
                        evaluate condition             |~
                        A COMP      ....               |~
                        -> else IF ....     ---        |~
                                               |       |~
                                               |       |~
                                               |       |~
ELSE                    SEG -> end if      <---     ---|~
                                                       |~
                                                       |~
                                                       |~
END IF                                             <---~
~0
~S1~O3.1.7 ELSE IF()
~BThis performs the semantics for the ELSE IF statement. It calls the
CODE ELSE() routine to handle the ELSE part and the CODE IF() routine
to handle the IF part.
~S1~O3.1.7.1 Code Planted
~BSee block IF (3.1.6.1).
~S1~O3.1.8 F.ELSE()
~BThis performs the semantics for the ELSE statement. It calls the CODE ELSE()
routine and then clears the ELSE label entry in the block nesting table
to ensure no further ELSE statements occur in this level of nesting.
~S1~O3.1.8.1 Code Planted
~BSee block IF (3.1.6.1).
~S1~O3.1.9 END IF()
~BThis performs the semantics for the END IF statement.
The block nesting table is inspected to ensure that an IF statement does
not overlap a DO loop. If the END IF matches a Block IF Statement
then the label for the end of IF is planted and the block nesting
level decremented.
~S1~O3.1.9.1 Code Planted
~BNo code is planted for the END IF statement, but it is used to mark
the end of a block IF statement and plant the appropriate labels. See
the code for the block IF statement (3.1.6.1).
~S1~O3.1.10 F.DO()
~BThis performs the semantics for the DO statement.
The block number nesting level and do table pointers are advanced. The
do and block nesting table entries are initialised. The label for
the DO loop is added to the do table and marked as a do label in
the label table. The DO variable is checked to ensure it is a scalar
of a suitable arithmetic type.
~BThe three parameters of the DO statement are evaluated in turn
and four types of DO loop are identified.
The most efficient code for a DO loop can be generated for an
integer loop with a unit increment. A DO loop may
have an Integer loop control variable with a non unit constant
increment parameter, or a Real or Double Precision control variable
with a simple constant increment parameter (e.g. 1.0 is a simple
Real increment). The third case is an Integer control variable
with a variable increment parameter, and the fourth case is all other Real
and Double Precision increments.
~BFour different code sequences are generated for the four cases. In
the first three cases the loop control variable is used to count the
number of iterations, but in the third case the Real arithmetic
involved would cause errors to accumulate so a trip count must be used.
~BFurther code is planted at the end of the DO loop by the procedure
DO.LABEL (3.1.19).
~S1~O3.1.10.1 Code Planted
~3
~
a) For an integer control variable with unit constant increment:~
~
~MTL.CV.CYCLE(CV,INIT,MODE)~
~NTL.CV.LIMIT(LIMIT)~
~
b)  For an Integer Control Variable, a non-unit Constant Increment or~
    Real/Double Precision Control Variable,~
    Simple Constant Increment:~
~
~
~Mevaluate termination parameter in A
~Nstore value
~Nevaluate Start Parameter in A
   loop:~NA => Control Variable
~NA COMP TERM
~N-> end.label IF loop complete~
~
~
c)  For an Integer Control Variable and Variable Increment:~
~
~
~Mevaluate termination parameter in A
~NStore Value
~Nevaluate increment parameter in A
~Nstore value
~Nextract sign
~Nstore in Mult
~Nevaluate start parameter in A
   loop:~NA => control variable
~NA - term
~NA * Mult
~NA COMP 0
~N-> end.label IF >
~
~
d)  For a Real/Double Precision control variable:~
~
~
~Mevaluate termination parameter in A
~Nstore value
~Nevaluate increment parameter in A (if present)
~Nstore value
~Nevaluate start parameter in A
~NA => control variable
~NA -: term
~NA + Incr
~NA / Incr
~NA ACONV Int
~X%\
~NTL.CYCLE(%3000)~
~X%%
~0
~S1~O3.1.11 F.CONTINUE()
~BThis performs the semantics for the CONTINUE statement. As the
CONTINUE statement has no effect, the semantics do nothing and no
code is planted.
~S1~O3.1.12 F.STOPAUSE(ACTION)
~BThis performs the semantics for the STOP and PAUSE statements.~
~BThis procedure is also called on processing the END
statement of the main program unit.~
~BWhen the STOP or PAUSE statement contains
a digit string or character string, a character
constant for the string is created and the appropriate
monitoring procedure called. If the statement contains no string
then the page and line number of the
STOP statement is passed to the monitoring procedure.~
~S1~O3.1.12.1 Code Planted~
~T# 18
~
#a)  No string parameter~
#       STKLB FIO.F.STP/FIO.PAUSE~
#       STK PARAM Page line number~
#       ENTER~
~
#b)  String parameter~
#       STKLB FIO.STP.CH/FIO.PAUSE.CH~
#       A = REF character constant~
#       STACK A~
#       ENTER~
~S1~O3.1.13 END()
~BThis performs the semantics for the END statement. The END statement
marks the end of a program unit, which may be a SUBROUTINE, FUNCTION,
BLOCK DATA or PROGRAM.~
~BNumerous actions are required in completing a
program unit. They are as follows:~
~T# 6
~
a)
~IThe COMMON.LIST of each common block used
in the program unit is reset.~
~
b)
~IFor BLOCK DATA program units the presence of DATA statements is
checked and a TL.END.BLOCK issued.~
~
c)
~IFor non BLOCK DATA program units~
~3
~
~I  1) Presence of executable statements is checked~
~I  2) All BLOCK IF's and DO control structures~
~I     are checked to be complete~
~I  3) All labels referenced are defined~
~
d)
~IFor main program units code for an
implicit STOP is planted by calling the procedure
F.STOPAUSE.~
~
e)
~IFor subroutines and function program units~
~
~I  1) an implicit RETURN is planted by calling~
~I     the procedure F.RETURN.~
~I  2) For all entries to the program unit the~
~I     associated argument specification is~
~I     completed, and if these were previous~
~I     references to the entry a consistency~
~I     check is made between the implicit~
~I     and actual specification. The global~
~I     properties of the entry are finally~
~I     updated.~
~
f)
~IThe local and label hash table is reset, and
the pointer controlling allocation in the LOCAL.SPACE
is reset.~
~0
~S1~O3.1.14 CALL()
~BThis performs the semantics for the CALL statement.~
~BCode for a CALL statement is generated
by coding an expression which just contains
a subroutine reference. Prior to coding
the expression tree is
examined for the following three reasons~
~
1)
~IIf the subroutine name has no argument list, then
this would be processed by REDUCE.EXPR as a subroutine
name and not a subroutine reference, therefore the
expression tree is modified so that it has an empty
argument list.~
~
2)
~IIf the subroutine name is as yet not defined
then REDUCE.EXPR would make it an implicit
function, therefore the properties of the name are
updated to make it an implicit subroutine.~
~
3)
~ITo prevent recursive subprogram calls.~
~BThe alternate return facility of CALL is
implemented in the following way.
Label arguments in a subroutine reference are not passed
as actual arguments. All subroutines yield an integer result
indicating the required alternate return.
On return from calling a subroutine if there are
any label arguments present then the subroutine
result determines to which alternate return control is
to be transferred.~
~BThis is achieved by creating a vector containing the
alternate return labels.~
~S1~O3.1.14.1 Code Planted~
~
Subroutine call.~
~
If there are any label arguments the following
code is generated.~
~T# 26
~
#A => B~
#B - 1~
#retain B in use~
#B COMP 0~
#IF < 0, -> Label~
#retain B in use~
#B COMP no. of label arguments~
#IF >= 0, -> Label~
#D = REF of vector containing alternate~
#    return labels~
#SEL EL~
#SEG -> D[]~
#Label:~
~S1~O3.1.15 RETURN()
~BThis performs the semantics for the RETURN statement. A check is made
to ensure this statement is not used in the Main Program Unit.~
~BFor RETURNS in a FUNCTION then the automatic loading
of the result facility of MUTL is employed, (i.e.
RETURN 0 is planted).~
~BWhen RETURNS in SUBROUTINES have an argument
this is evaluated in the A register, otherwise a value
of zero is loaded into A, then a RETURN A
is planted.~
~S1~O3.1.16 PLANT BRANCH()
~BThis routine is used by the GO TO(), ARITH IF() and LOG IF()
semantic routines to plant a branch order to a statement label. A
check is made to ensure the branch is not to the next statement and then the
statement reference is processed by PROCESS STAT REF(), and then the branch is p
lanted.
The branch may be conditional or unconditional.
~S1~O3.1.17 CODE IF()
~BThis plants the code for the Block IF as described in 3.1.6.
~S1~O3.1.18 CODE ELSE()
~BThis plants the code for the ELSE statement as described in 3.1.8. It
also checks to ensure that the statement is not contained in a logical IF,
and if the nesting or construction of the block IF is correct. The block
nesting table is updated.
~S1~O3.1.19 EVALUATE DO PARAM(EXPR.INDEX,DO.TABLE.INDEX)
~BThis evaluates the increment and terminal parameters of the DO statement
using CODE.EXPR and updates the DO table accordingly.
~S1~O3.1.20 PROCESS STAT REF(LABEL.TYPE,LABEL)LABEL.PROP^
~BThis routine is called whenever a statement label is referenced and
performs checks on the consistant use of a label and violations of the
block nesting structure using information stored in the label property
table and the block nesting table. These tables are updated for each
reference. No executable code is planted by this routine,
but it does declare a label or format area if necessary.
~S1~O3.1.21 PROCESS STAT LABEL(LABEL.TYPE,LABEL.PROP^)
~BThis routine is called whenever a statement label is defined and performs
similar checks as the last routine. The appropriate tables are updated, and no
executable code is planted, but it does declare a
label or format area if necessary.
~S1~O3.1.22 DO LABEL()
~BThis routine is called when the terminal label of a DO loop is encountered
and plants the end of loop code. It also performs checks on the correct nesting
of loops and block IF statements.
~S1~O3.1.22.1 Code Planted
~3
~
~
   a) using TL.CV.CYCLE:~
             TL.REPEAT()~
~
   b)  without a trip count:~
~
             A = Control Var~
             A + Increment~
             SEG -> loop~
     end.label:~
~
~
   c)  with a trip count:~
~
             A = Control Var~
             A + Increment~
             A => Control Var~
             TL.REPEAT()~
~0
~S1~O3.2 Data Structures
~BThere are several data structures used in this section. The semantics
for the arithmetic IF uses a vector of labels and branches to generate
code, the block nesting structures of IF and DO need a table to control
the nesting and the DO loop needs a table to store information on each
loop. The compilers property tables for labels and local variables are
also accessed.
~S1~O3.2.1 Arithmetic IF
~BThe semantics for the Arithmetic IF generate an index from zero to 15
which represent the code to be planted. Only zero to 13 cause code to be
planted, and a vector of 14 integers is used. This vector contains
indices to a vector containing a representation of the code to be planted.
The code is in the form of pairs representing the branch order and the
label from the analysis record.~
~3
~Q 14
~
For example:~
~
               0 1 2 3              13~
               ------------------------~
              |0|3|                 |  |   index value~
               ------------------------~
~
~
               0 1 2 3 4~
               ------------------------~
              |1|3|2|2|3                    code vector~
              |<|>|-|=|>~
               ------------------------~
~0
~
This represents that for an index of zero the following code is planted:~
~3
~
              -> 1st label IF <~
              -> 3rd label IF >~
              SEG -> 2nd label~
~0
~S1~O3.2.2 Block nesting table
~BThe block nesting table NEST.TBL is used to control the nesting of block IF
and DO statements. There is an entry in the table for each level of
nesting currently in use in a program unit. Each entry in the table
has three fields containing the index of the labels for the ELSE part
of an IF, the END part of an IF and the block number for that level
of nesting. When the two label index fields are empty the entry
represents a DO loop otherwise it represents a block IF. The ELSE label
field is cleared when an ELSE part is processed to ensure a block
IF does not have more than one ELSE part.
~BThe current table entry is indicated by the current nesting level
variable CUR.NEST.LEV.G,
and the current block number is contained in the entry of the current
nesting level.~
~Q 18
~S1Nesting table:~
~3
~
                   |          |           |            |~
                   |          |           |            |~
                   |          |           |            |~
 ~O              ~O    |          |           |            |~
|              |   |          |           |            |~
|      2       |   |          |           |            |~
|~O              ~O|   |          |           |            |~
Max block number   |~O          |           |            ~O|~
                   |          |           |            |  current~
                   |          |           |            |  block~
 ~O              ~O    |~O          |           |            ~O|  number~
|              |   |          |           |            |~
|      2       |   |else label| end label |block number|~
|~O              ~O|   |~O          |           |            ~O|~
~0
Nesting level~
~BThe block nesting table is used for static scope checking of
labels and GOTOs in the following way. A reference to a label and a
referenced label both have a nesting level and a block number
associated with them, and by comparing these a check for a valid
branch is made. Consider the following nested structure:~
~3
~Q 39
~
                                   Nesting level    Block Number~
                                         0                0~
IF     THEN~
                                         1                1~
       IF     THEN~
                                         2                2~
       ELSE~
                                         2                3~
       END IF~
                                         1                1~
ELSE   IF     THEN~
                                         1                4~
              IF     THEN~
                                         2                5~
              ELSE~
                                         2                6~
              END IF~
                                         1                4~
ELSE~
                                         1                7~
       IF     THEN~
                                         2                8~
       ELSE~
                                         2                9~
       END IF~
                                         1                7~
END IF~
                                         0                0~
IF  THEN~
                                         1               10~
    IF     THEN~
                                         2               11~
    END  IF~
                                         1               10~
ELSE~
                                         1               12~
END  IF~
                                         0                0~
~0
~BWithin such a structure there may be forward jumps and backward
jumps which are both valid and invalid. The simplest test which can
be applied is to compare the nesting levels of the label and its
reference. For a valid jump the label nesting should be less than or
equal to the reference nesting level. This prevents jumping into a
nested structure from outside. To prevent jumping from one separate
structure to another of a seemingly correct nesting level the block
numbers must be used. It should be noted that each block has a unique
number allocated in a monotonically increasing fashion.
~BTwo different methods for comparing block numbers are used depending
whether it is a forward or backward reference to a label. For a forward
reference to a label then the label block number must be less than or
equal to the reference block number. However, for a backward reference
the label block number must be the same as the current block number
for the same level of nesting (this is obtained from the nesting table).
~BThis method of scope checking can be illustrated with the example
nested structure given earlier. Select reference points and a label
points in the structure to illustrate both valid and invalid, forward
and backward jumps and see that the comparison of the numbers provided
will check the scope correctly.~
~BThe data structure interface variables are
used as follows:~
~3
~
CUR.NEST.LEV.G   Indexes the current entry in the~
                 nesting table~
CUR.BLOCK.NO.G  Most recently allocated block~
                 number.~
~0
~S1~O3.2.3 DO loop table
~BThis table DO.T is used by the semantic of the DO loop to store details
of each nested loop so that when the end of the loop is encountered
the correct code can be planted.
The next available entry is pointed at by DO.P.G.
The table has an entry for each loop
currently active and each entry
is of type DO.E.  The fields of this type are as follows:~
~T% 10
~
DO.LAB~IFortran Label in the DO standard.~
~
LOOP.ST~IMUTL name of the internal label on
the top of the loop.~
~
LOOP.END~IMUTL name of the internal label for the end of the loop.~
~
CV~IPointer to property entry of control variable for loop.~
~
INC~IMUTL name for increment argument.~
~
TERM~IMUTL name for terminal argument.
~Y
~V9 -1
~P
~D15
~HFLOWCHARTS
~
~
~H                FTN081
~V9 -1
~F
@TITLE FTN08(1,11)
@COL 1S-2R-5R-6R-7R-9F
@FLOW 1-2-5-6-7-9
@BOX 1.0
CONTROL STATEMENT SEMANTICS
@BOX 2.0
[IMPORTS FTN08/1]
MODULE HEADING
@BOX 5.0
SCALAR DECLARATIONS
@BOX 6.0
VECTOR DECLARATIONS
@BOX 7.0
PROCEDURES IN MODULE
   GO TO:8.1:
   COMPUTED 60 TO:8.2:
   ASSIGNED 60 TO:8.3:
   ARITHMETIC IF:8.4:
   LOGICAL IF:8.5:
   BLOCK IF:8.6:
   ELSE IF:8.7:
   ELSE:8.8:
   END IF:8.9:
   DO:8.10:
   CONTINUE:8.11:
   STOP/PAUSE:8.12:
   END:8.13:
   CALL:8.14:
   RETURN:8.15:
   PLANT BRANCH:8.16:
   PLANT IF CODE:8.17:
   PLANT ELSE CODE:8.18:
   EVALUATE DO PARAM:8.19:
   PROCESS STAT REF:8.20:
   PROCESS STAT LABEL:8.21:
   DO LABEL:8.22:
@BOX 9.0
END
@BOX 2.1
#FTN08/1
;MODULE (JUMPED.G,DO.PTR.G,
   CUR.NEST.LEV.G,CUR.BLOCK.NO.G,ASS.GOTO.LOOP.NAME.G,
   ASS.GOTO.VEC.NAME.G,NEST.TBL,DO.T,GOTO,COMP.GOTO,
   ASS.GOTO,ARITHIF,LOGIF,BLOCKIF,ELSEIF,FELSE,
   ENDIF,FDO,FCONTINUE,FSTOPAUSE,FEND,CALL,
   RETURN,PLANT.BRANCH,PROCESS.STAT.REF,
   PROCESS.STAT.LABEL,DO.LABEL);
@BOX 5.1
; TYPE DO.E IS
        $LO24 DO.LAB
        $IN LOOP.ST, LOOP.END, INC, TERM,SIGN
        ADDR LOCAL.PROP CV
; *GLOBAL 2
;$IN DO.TYPE.G,IN.LOG.IF.G,DO.LEN.G
;$LO8[5]LN.G
;$LO8 JUMPED.G
;$IN DO.PTR.G
;$IN CUR.NEST.LEV.G,CUR.BLOCK.NO.G
;$LO16 ASS.GOTO.LOOP.NAME.G,
       ASS.GOTO.VEC.NAME.G
;$RE32 R.G
;$RE64 D.G
@BOX 6.1
;$LO16[NEST.TBL.Z.L]NEST.TBL
;DO.E[DO.TBL.Z.L]DO.T
; *GLOBAL 0
@BOX 7.1
;P.SPEC GOTO()
;P.SPEC COMPGOTO()
;P.SPEC ASSGOTO()
;P.SPEC ARITHIF()
;P.SPEC LOGIF()
;P.SPEC BLOCKIF()
;P.SPEC ELSEIF()
;P.SPEC FELSE()
;P.SPEC ENDIF()
;P.SPEC FDO()
;P.SPEC FCONTINUE()
;P.SPEC FSTOPAUSE($IN)
;P.SPEC FEND()
;P.SPEC CALL()
;P.SPEC RETURN()
;P.SPEC PLANT.BRANCH($IN,$IN32)
;P.SPEC PROCESS.STAT.REF($IN,$LO24)/ADDR LABEL.PROP
;P.SPEC PROCESS.STAT.LABEL($IN,ADDR LABEL.PROP)
;P.SPEC DO.LABEL($LO24)
;PSPEC CODE.IF($IN)
;PSPEC CODE.ELSE()
;PSPEC EVALUATE.DO.PARAM($IN,ADDR $IN,$IN)/ADDR CONST.PROP
;PSPEC CR.LABEL.NAME($IN32)
#FTN08.1
#FTN08.2
#FTN08.3
#FTN08.4
#FTN08.5
#FTN08.6
#FTN08.7
#FTN08.8
#FTN08.9
#FTN08.10
#FTN08.11
#FTN08.12
#FTN08.13
#FTN08.14
#FTN08.15
#FTN08.16
#FTN08.17
#FTN08.18
#FTN08.19
#FTN08.23
#FTN08.20
#FTN08.21
#FTN08.22
@BOX 9.1
*END
@END
@TITLE FTN08/1(1,11)
@COL 1S-2R-3R
@COL 4R-5R-6R-7F
@FLOW 1-2-3-4-5-6-7
@BOX 1.0
CONTROL IMPORTS
@BOX 2.0
IMPORTED TYPES
@BOX 3.0
IMPORTED LITERALS
@BOX 4.0
IMPORTED SCALARS
@BOX 5.0
IMPORTED VECTORS
@BOX 6.0
IMPORTED PROCEDURES
@BOX 7.0
END
@BOX 2.1
;IMPORT TYPE EQUIV.PROP
;TYPE NAME.T IS $AD[$LO8] NAME :: ??? JM 27-DEC-82
;TYPE PROPS;
;TYPE LOCAL.PROP;
;TYPE CONST.PROP;
;TYPE GLOBAL.PROP IS
       ADDR GLOBAL.PROP G.NEXT.P
       NAME.T G.NAME
       $LO8 G.KIND
       $LO16 G.TL.NAME
       ADDR [$LO8] G.ARG.SPEC.P
;TYPE L.ALT.TYPE IS
       ADDR CONST.PROP L.CONST.P OR
       ADDR EQUIV.PROP L.EQT.P
       $IN L.DISP OR
       ADDR [$LO8] L.ARG.SPEC.P
       $LO8 L.INTR.NO
       $LO16 L.CH.RES.NAME
       $LO16 L.SPEC.TL.NAME OR
       ADDR [$IN] L.AS.DUMP
       ADDR [PROPS] L.PROPS.T.DUMP
;TYPE LOCAL.PROP IS
       ADDR LOCAL.PROP L.NEXT.P
       NAME.T L.NAME
       ADDR LOCAL.PROP L.LINK1, L.LINK2
       $LO8 LTYPE
       $LO16 LSPECS, LKIND
       $IN L.LEN
       $LO16 L.TL.NAME
       ADDR [$IN] L.ARR.SPEC.P
       L.ALT.TYPE L.ALT
;TYPE COMMON.PROP IS
       ADDR COMMON.PROP C.NEXT.P
       NAME.T C.NAME
       $LO8 C.KIND
       ADDR LOCAL.PROP C.HEAD, C.TAIL
       ADDR C.SIZE
       ADDR COMMON.PROP C.PREV.P
       $LO8 C.AREA.NO
;TYPE LABEL.PROP IS
       ADDR LABEL.PROP S.NEXT.P
       $LO24 S.NAME
       $LO8 S.KIND
       $LO16 S.LEVEL, S.BLOCK, S.TL.NAME, S.ID
;TYPE PROPS IS
       $IN32 INT OR
       ADDR ADDRESS OR
       ADDR LOCAL.PROP LOC OR
       ADDR GLOBAL.PROP GLOB OR
       ADDR COMMON.PROP COM OR
       ADDR CONST.PROP CONST
;TYPE CONST.PROP IS
      $IN32 INT.CONST OR
      $RE32 REAL.CONST OR
      $RE64 DP.CONST OR
      $RE32 R.COMP.CONST, I.COMP.CONST OR
      $LO16 LOG.CONST OR
      ADDR[$LO8] CH.CONST OR
      $LO64 T.CONST OR
      $LO8[8] H.CONST
      $LO8 H.PR :: @@@ BCT 30-DEC-82
@BOX 3.1
;IMPORT LITERAL ENTER.TRAP,FIO.F.STP
;IMPORT LITERAL I.ACC.T.L, AS.Z.L,PROPS.Z.L,NEST.TBL.Z.L,
     DO.TBL.Z.L,LABEL.HASH.Z.L,
     GLOBAL.HASH.Z.L,LOCAL.HASH.Z.L,LOCAL.SPACE,FMT.TABLE.EL.TYPE.L,L.ACC.T.L
;IMPORT LITERAL STAT.KIND.Z.L :: ??? JM 22-DEC-82
;IMPORT LITERAL $LO32 LOOP.66.BIT.L
;IMPORT LITERAL I.PARAM.Z
@BOX 4.1
;$IN32 NEXT.ST.LABEL.G,CURRENT.LABEL.G,CUR.LIN.PAG.G
;$IN STAT.AP.G,MUTLN.G,END.AP.G
;ADDR LABEL.PROP F.S.PROP.G
;ADDR LOCAL.PROP F.L.PROP.G,L.CUR.PU
;ADDR GLOBAL.PROP F.G.PROP.G
;$LO8 ASSIGN.FL.G,PU.G
;$IN FSS,PROPS.I,END.SS.G,A.AP.G,B.AP.G,T.AP.G
;$LO32 INFORM.LINE.G
;$LO16 TL.ONE.G,TL.ZERO.G,FMT.DICT.NAME.G
;$LO16 DEBUG.PU.G
;$IN EXEC.ST.CNT.G,PU.START.MUTLN.G
;ADDR COMMON.PROP COM.LIST.G
;$IN DATA.ST.CNT.G,CUR.A.TYPE.G,DONE.DECLARATIONS
@BOX 5.1
; $LO16 [7] MODE
;$IN[AS.Z.L] AS
;PROPS[PROPS.Z.L] PROPS.T
; $LO8[STAT.KIND.Z.L] STAT.KIND :: ??? JM 22-DEC-82
; ADDR LABEL.PROP [LABEL.HASH.Z.L] S.HASH
; ADDR GLOBAL.PROP [GLOBAL.HASH.Z.L] G.HASH
; ADDR LOCAL.PROP [LOCAL.HASH.Z.L] L.HASH
@BOX 6.1
;P.SPEC STATEMENT.DRIVER()
;P.SPEC SYNTAX.CHECK($IN,$IN)/$IN
;P.SPEC CHECK.IMPLICIT.DECL(ADDR LOCAL.PROP)/$IN
;P.SPEC CHECK.SPECS(ADDR[$LO8],ADDR[$LO8])/$IN
;P.SPEC REDUCE.EXPR($IN)/$IN
;P.SPEC CODE.EXPR($IN,$IN)/$IN
;P.SPEC SET.A.TYPE($IN,$IN)
;P.SPEC V.DECL($IN, $IN, $IN)/$IN
;P.SPEC MUTL.TYPE($IN, $IN)/$IN
;P.SPEC CHANGE.CONST.TYPE(ADDR CONST.PROP,$IN,$IN)
;P.SPEC DECL.ARITH.CONST(ADDR CONST.PROP,$IN)/$IN
;P.SPEC DECL.CHAR.CONST($IN)/$IN
;P.SPEC PL.STK.LB($LO8,$IN)
;P.SPEC PL.VAR.OP($IN,ADDR LOCAL.PROP)
;P.SPEC ADD.G.NAME(ADDR NAME.T)/ADDR GLOBAL.PROP
;P.SPEC ADD.S.NAME($LO24)/ADDR LABEL.PROP
;P.SPEC SET.B.TYPE($IN)
;P.SPEC FAULT($IN,$IN)
;P.SPEC GET.AREA($IN,$IN)/$IN
;P.SPEC PROCESS.STATEMENT($IN)
;P.SPEC MONITOR($IN)
;P.SPEC COPY.CONST(ADDR CONST.PROP,$IN)/ADDR CONST.PROP
;P.SPEC ADD.CONST($LO8)/ADDR CONST.PROP
;P.SPEC RESET.SPACE($IN)
;P.SPEC PL.STK.PAR($IN)
;L.SPEC TL.REG($IN)
;L.SPEC TL.PL($IN,$IN)
;L.SPEC TL.I.PARAM($IN, $IN, $IN)
;L.SPEC TL.LABEL.SPEC(ADDR[$LO8],$IN)
;L.SPEC TL.C.LIT.32($IN,$IN32)
;L.SPEC TL.ASS($IN,$IN)
;L.SPEC TL.ASS.VALUE($IN,$IN)
;L.SPEC TL.ASS.END()
;L.SPEC TL.LABEL($IN)
;L.SPEC TL.S.DECL(ADDR[$LO8],$IN,ADDR)
;L.SPEC TL.C.LIT.16($IN,$IN16)
;L.SPEC TL.END.PROC()
;L.SPEC TL.END.BLOCK()
;L.SPEC TL.SET.TYPE($IN,$IN)
;L.SPEC TL.CYCLE($IN)
;L.SPEC TL.CV.CYCLE($IN,$IN,$IN)
;L.SPEC TL.CV.LIMIT($IN)
;L.SPEC TL.REPEAT()
@END
@TITLE FTN08.1(1,10)
@COL 1S-2T-3R-4R-5F
@FLOW 1-2N-3-4-5
@FLOW 2Y-4
@BOX 1.0
GO TO
@BOX 2.0
NEXT LABEL PRESENT?
@BOX 3.0
NOTE JUMPED
@BOX 4.0
PLANT BRANCH ORDER:8.16:
@BOX 5.0
END
@BOX 1.1
;PROC GO.TO
@BOX 2.1
;IF NEXT.ST.LABEL.G /= 0
@BOX 3.1
; 2 => JUMPED.G
@BOX 4.1
;PLANT.BRANCH(%4F,INT OF PROPS.T[AS[STAT.AP.G]])
@BOX 5.1
;END
@END
@TITLE FTN08.2(1,11)
@COL 1S-2T-3R-4R-5R-6R-7R-8R-9F
@COL 10R
@ROW 5-10
@FLOW 1-2N-3-4-5-6-7-8-9
@FLOW 2Y-10-9
@BOX 1.0
COMPUTED GO TO
@BOX 2.0
REDUCE EXPR:11.2:
NOT AN INTEGER EXPR?
@BOX 3.0
DETERMINE LENGTH OF LABEL LIST
@BOX 4.0
CODE EXPR : 11.3: IN B
@BOX 5.0
PLANT
RETAIN B REG
B COMP 0
IF =<, -> NO.SWITCH
RETAIN B REG
B COMP BOUND
IF >, -> NO.SWITCH
@BOX 6.0
DECLARE A SWITCH VECTOR
PLANT
B-1
D = REF OF SWITCH VECTOR
SEL EL
-> D[]
@BOX 7.0
FOR EACH LABEL IN LIST
PROCESS STAT.REF : 8.20:
ADD AND TO SWITCH
@BOX 8.0
DEFINE NO.SWITCH LABEL
@BOX 9.0
END
@BOX 10.0
FAULT
@BOX 1.1
;PROC COMP.GO.TO
;$IN AP,AP1,N,LAB,SW,EAP
;LITERAL /ADDR [$LO8] NILSTR=
;$IN T
;ADDR LABEL.PROP S
;LITERAL / ADDR LABEL.PROP NIL.S=



@BOX 2.1
;IF REDUCE.EXPR(AS[STAT.AP.G => AP+1]=>EAP) & 7 /= 3
@BOX 3.1
;AS[AP] => AP1
;0 => N
;WHILE AS[AP1] >=0 DO
   ;1+>N
   ;1+>AP1
;OD
@BOX 4.1
;CODE.EXPR(EAP,%102)
@BOX 5.1
;TL.REG(1)
;TL.PL(15,TL.ZERO.G)
;TL.LABEL.SPEC(NIL.STR,3)
;MUTL.N.G => LAB +1 => MUTL.N.G
;TL.PL(%4D,LAB)
;TL.REG(1)
;TL.C.LIT.16(%44,N)
;TL.PL(15,0)
;TL.PL(%4E,LAB)
@BOX 6.1
;TL.S.DECL(NIL.STR,%2C,-1)
;MUTL.N.G => SW+1 => MUTL.N.G
;TL.PL(9,TL.ONE.G)
;TL.PL(%61,SW)
;TL.PL(%64,0)
;TL.PL(%4F,%1004)
@BOX 7.1
;TL.ASS(SW,-1)
;AS[AP] => AP1
;WHILE AS[AP1] => T >= 0 DO
   ;IF PROCESS.STAT.REF(2,INT OF PROPS.T[T]) => S /= NIL.S THEN
      ;TL.ASS.VALUE(S.TL.NAME OF S^,1)
   ;FI
   ;1 +> AP1
;OD
;TL.ASS.END()
@BOX 8.1
;TL.LABEL(LAB)
@BOX 9.1
;END
@BOX 10.1
;FAULT(38,0-AS[EAP+3])
@END
@TITLE FTN08.3(1,11)
@COL 1S-2T-3R-14T-4T-5T-7T-8R-10R-11R
@COL 9R-6R-12T-15R-16R-13F
@ROW 5-9
@ROW 7-6
@ROW 10-12
@FLOW 1-2N-3-14N-4N-5N-7N-8-10-11-12N-15-16-13
@FLOW 14Y-13
@FLOW 2Y-14
@FLOW 4Y-9-13
@FLOW 5Y-6-11
@FLOW 7Y-10
@FLOW 12Y-16
@BOX 1.0
ASSIGNED GO TO
@BOX 2.0
NEXT LABEL PRESENT OR IN LOGICAL IF?
@BOX 3.0
NOTE JUMPED
@BOX 4.0
GET TYPE OF VARIABLE
NOT INTEGER SCALAR?
@BOX 5.0
SET A TYPE
LABEL LIST PRESENT?
@BOX 6.0
FIND LENGTH OF LIST
CREATE VECTOR
PLANT A = LENGTH
@BOX 7.0
LABEL VECTORS CREATED?
@BOX 8.0
CREATE LABEL VECTORS
@BOX 9.0
FAULT
@BOX 10.0
PLANT A = BOUND
@BOX 11.0
DECLARE LOOP VAR
   IF NECESSARY
PLANT LOOP TO
   VALIDATE LABEL:11.23:
PLANT BRANCH
@BOX 12.0
LABEL LIST ABSENT
@BOX 13.0
END
@BOX 14.0
CHECK IMPLICIT DECLARATIONS:6.5:
INVALID?
@BOX 15.0
FILL VECTORS WITH LABELS :8.20:
@BOX 16.0
PLANT FAIL TRAP:11.22:
@BOX 1.1
;PROC ASS.GO.TO
;$IN AP,APL,T
;$IN L,N
;$LO16[512] S.ID.T
;$LO16 VEC,LIMIT,LOOP
;ADDR LOCAL.PROP LP
;LITERAL/ADDR[$LO8] NILSTR=
;ADDR LABEL.PROP S
;LITERAL/ADDR LABEL.PROP NIL.S=
@BOX 2.1
;IF NEXT.ST.LABEL.G /= 0 OR IN.LOG.IF.G = 1
@BOX 3.1
; 2 => JUMPED.G
@BOX 14.1
;LOC OF PROPS.T[AS[STAT.AP.G => AP]] => LP
;IF CHECK.IMPLICIT.DECL(LP) /= 0
@BOX 4.1
;IF L.KIND OF LP^ /=1 OR L.TYPE OF LP^ /= 3
@BOX 5.1
;-1 => CUR.A.TYPE.G
;IF AS[AP=>APL+1] > 0
@BOX 6.1
; 0 => T
; WHILE AS[1+>APL] > 0 DO 1 +> T OD
; TL.S.DECL(NIL.STR,%2C,-1)
; TL.S.DECL(NIL.STR,%84,-1)
; MUTLN.G => VEC + 2 => MUTLN.G
; TL.C.LIT.16(%44,T-1)
; 0 => LIMIT
@BOX 7.1
; IF ASS.GOTO.VEC.NAME.G => VEC /= 0
@BOX 8.1
; TL.S.DECL(NIL.STR,%2C,-1)
; TL.S.DECL(NIL.STR,%84,-1)
; MUTLN.G => ASS.GOTO.VEC.NAME.G => VEC +2 => MUTLN.G
@BOX 10.1
;TL.PL(%46,%2F)
;TL.PL(%21,VEC)
;TL.PL(%45, %4044)
;TL.PL(%29,TL.ONE.G)
; %3000 => LIMIT
@BOX 11.1
; IF ASS.GOTO.LOOP.NAME.G = 0 THEN
     TL.S.DECL(NIL.STR,%44,0)
     ; MUTLN.G => ASS.GOTO.LOOP.NAME.G +1 => MUTLN.G
 FI
; TL.CV.CYCLE(ASS.GOTO.LOOP.NAME.G,LIMIT,2)
; TL.CV.LIMIT(TL.ZERO.G)
; TL.LABEL.SPEC(NIL.STR,3)
; MUTLN.G => LOOP + 1 => MUTLN.G
; TL.PL(%61,VEC+1)
; SET.B.TYPE(1)
; TL.PL(%02,ASS.GOTO.LOOP.NAME.G)
; TL.PL(%64,0)
; TL.PL(%46,%44)
; TL.PL(%22,%1004)
; PL.VAR.OP(%2F,LP)
; TL.PL(%4A,LOOP)
; TL.PL(%61,VEC)
; TL.PL(%02,ASS.GOTO.LOOP.NAME.G)
; TL.PL(%64,0)
; TL.PL(%4F,%1004)
; TL.LABEL(LOOP)
; TL.REPEAT()
@BOX 16.1
; PL.STK.LB(ENTER.TRAP,0)
; PL.STK.PAR(8)
; PL.STK.PAR(111)
; TL.PL(%42,0)
@BOX 12.1
; IF AS[AP=>APL+1] < 0
@BOX 15.1
; TL.ASS(VEC,-1)
; -1 => N
; WHILE AS[1+>APL] => L  > 0 DO
     IF PROCESS.STAT.REF(2,INT OF PROPS.T[L]) => S /= NIL.S THEN
          ;S.ID OF S^ => S.ID.T[1+>N]
          ;TL.ASS.VALUE(S.TL.NAME OF S^,1)
     FI
  OD
; TL.ASS.END()
; TL.ASS(VEC+1, -1)
; -1 => T
; WHILE 1+>T =< N DO
   ;TL.C.LIT.16(%84, S.ID.T[T])
   ;TL.ASS.VALUE(0,1)
; OD
; TL.ASS.END()
@BOX 13.1
;END
@BOX 9.1
; LP => F.L.PROP.G
; FAULT(36,1)
@END
@TITLE FTN08.4(1,11)
@COL 1S-2R-26R-3T-30T-4T-6R-16R-31R-18F
@COL 22T-7T-8T-23T-9R-10T-11R-12R-13T-14R
@COL 19R-20R
@ROW 8-19
@ROW 2-22
@FLOW 1-2-26-3N-30N-4N-6-22N-7N-8N-23N-9-10N-11-12-13N-14-13
@FLOW 30Y-31-18
@FLOW 4Y-16-18
@FLOW 22Y-10
@FLOW 7Y-19-10
@FLOW 8Y-20-10
@FLOW 23Y-10
@FLOW 10Y-12
@FLOW 13Y-18
@FLOW 3Y-18
@BOX 1.0
ARITHMETIC IF
@BOX 2.0
CODING VECTORS
@BOX 26.0
ADD OPERATOR NODE TO TREE
EXPR COMP 0
@BOX 3.0
REDUCE.EXPR : 11.2:
INVALID?
@BOX 30.0
INVALID TYPE?
@BOX 4.0
CODE.EXPR : 11.3:
ANY LABEL < 1
@BOX 6.0
CALCULATE INDEX VARIABLE
BY COMPARING LABELS:
SET BIT 1 IF FIRST = NEXT
SET BIT 2 IF FIRST = SECOND
SET BIT 3 IF THIRD = NEXT
SET BIT 4 IF THIRD = SECOND
@BOX 22.0
IS INDEX <> ZERO?
@BOX 7.0
(FIRST = THIRD) &
(SECOND = NEXT) ?
@BOX 8.0
FIRST = THIRD?
@BOX 23.0
SECOND <> NEXT?
@BOX 9.0
7 => INDEX
@BOX 10.0
IN LOGICAL IF OR
NEXT LABEL PRESENT ?
@BOX 11.0
NOTE JUMPED
@BOX 12.0
OBTAIN START AND END
OF CODE VECTOR
@BOX 13.0
END OF CODE?
@BOX 14.0
PLANT NEXT ORDER:8.16:
@BOX 16.0
FAULT
@BOX 31.0
FAULT
@BOX 18.0
END
@BOX 19.0
13 => INDEX
@BOX 20.0
11 => INDEX
@BOX 1.1
;PROC ARITH.IF
;$IN32 F,S,T,N,L
;ADDR CONST.PROP CP
;$IN AP,P,ST,FIN
;$LO8 I,CV1
@BOX 2.1
;DATAVEC CV($LO8)
%FF  %4C  0  %4E  2  %4F  1
%FF  %49  1  %4E  2
%4D  0   %4F 2
%4E  2
%FF  %4C  0  %49  1
%49  1
%4D  0
%FF  %4C  0  %4E  2
%4B  1   %4F 0
%4B  1
%4F  0
%4A  0   %4F 1
%4C  0
%4A  0
END
;DATAVEC CI($LO8)
0  7  12  16  18  23  25  27
32 36 38  40  44  46  48  48  48
END
@BOX 26.1
;%12F => AS[END.AP.G => P]
;AS[STAT.AP.G => AP] => AS[P+1]
;P+4 => AS[P+2]
;AS[AP+3] => AS[P+3] => AS[P+7]
;ADD.CONST(0) => C.P
;0 => INT.CONST OF C.P^
;%3010 => AS[P+4]
;0 => AS[P+5]
;C.P => CONST OF PROPS.T[1+>PROPS.I]
;PROPS.I => AS[P+6]
; 8 +> END.AP.G
@BOX 3.1
;IF REDUCE.EXPR(P) = -1
@BOX 30.1
;IF AS[AS[P+1]]->> 12 &7 /= 0 /= 1 /= 3
@BOX 4.1
;CODE.EXPR(P,%22)
;IF INT OF PROPS.T[AS[AP+1]] => F < 1 OR
INT OF PROPS.T[AS[AP+2]] => S < 1 OR
INT OF PROPS.T[AS[AP+3]] => T < 1
@BOX 6.1
;NEXT.ST.LABEL.G => N
;0 => I
;IF F = N THEN
   ;1 => I
;FI
;IF F=S THEN
  ;2 !> I
;FI
;IF T=N THEN
  ;4 !> I
;FI
;IF T=S THEN
   ;8 !> I
;FI
@BOX 22.1
;IF I > 0
@BOX 7.1
;IF F=T AND S=N
@BOX 8.1
;IF F=T
@BOX 23.1
;IF S /= N
@BOX 9.1
;7 => I
@BOX 10.1
;IF N > 0 OR IN.LOG.IF.G = 1
@BOX 11.1
; 2 => JUMPED.G
@BOX 12.1
;C.I[I] => ST
;C.I[I+1] => FIN
@BOX 13.1
;IF ST=FIN
@BOX 14.1
;IF C.V[ST] => CV1 = %FF THEN
   ;TL.REG(8)
   ;1+>ST
;ELSE
   ;ALTERNATIVE C.V[ST+1] FROM
      ;F => L
      ;S => L
      ;T => L
      ;N => L
   ;END
   ;PLANT.BRANCH(CV1,L)
      ;2 +> ST
;FI
@BOX 16.1
;FAULT(32,1)
@BOX 19.1
;13 => I
@BOX 20.1
;11 => I
@BOX 31.1
;FAULT(64,1)
@BOX 18.1
;END
@END
@TITLE FTN08.5(1,11)
@COL 17T-12R-19R-20R
@COL 2S-3T-32R-30T-4T-7T-31R-16T-8R-9R-6R-10F
@COL 21R-22R-13R
@ROW 17-16-13
@ROW 21-4
@FLOW 2-3N-32-30N-4N-7N-31-16N-8-9-6-10
@FLOW 4Y-13-10
@FLOW 7Y-17N-12-9
@FLOW 17Y-20-10
@FLOW 16Y-19-20
@FLOW 3Y-21-10
@FLOW 30Y-22-10
@BOX 2.0
LOGICAL IF
@BOX 3.0
REDUCE.EXPR : 11.2:
EXPR RESULT NOT LOGICAL?
@BOX 4.0
INVALID STAT IN A LOGICAL IF?
@BOX 7.0
NOTE A AND B NOT IN USE
RESULT OF COND IN T BITS?
@BOX 30.0
SYNTAX ANALYSIS : 4.:
A STATEMENT
FAIL?
@BOX 31.0
PLANT ACC COMP 1
@BOX 32.0
CODE.EXPR : 11.3:
@BOX 16.0
NEXT STAT A GO TO?
@BOX 8.0
SET JUMP COND TO IF /=
@BOX 9.0
DECLARE NEXT STAT LABEL
PLANT IF JUMPCOND, -> NEXT STAT
NOTE T NOT IN USE
@BOX 6.0
NOTE IN LOGICAL IF
PROCESS STATEMENT : 2.:
PLANT LABEL
@BOX 10.0
END
@BOX 17.0
NEXT STAT A GO TO
@BOX 12.0
INVERT COND
@BOX 21.0
FAULT
@BOX 22.0
FAULT
@BOX 19.0
SET COND TO IF =
@BOX 20.0
PLANT IF COND GO TO LABEL:8.16:
@BOX 13.0
FAULT
@BOX 14.0
END
@BOX 2.1
;PROC LOG.IF
;$IN AP,P,R,C,NL,T
;$IN STAT.NO
;LITERAL/ADDR[$LO8] NIL.STR=
;DATAVEC INV.COND($LO8)
10  9  12  11  14  13
END
@BOX 3.1
;IF REDUCE.EXPR(AS[STAT.AP.G] => P) & %F /= 4
@BOX 32.1
;CODE.EXPR(P,%22) => R
@BOX 30.1
;IF ASSIGN.FL.G /= 0 THEN
   ;2 => T
;ELSE
   ;1 => T
;FI
;IF SYNTAX.CHECK(END.SS.G,T) => STAT.NO < 0
@BOX 4.1
;IF STAT.KIND[STAT.NO] & %88 /= %08
@BOX 7.1
;-1 => A.AP.G => B.AP.G
;IF R > 0
@BOX 31.1
;TL.C.LIT.16(%84,1)
;TL.PL(%2F,0)
@BOX 16.1
;IF STAT.NO = 13
@BOX 8.1
;%A => R
@BOX 9.1
;TL.LABEL.SPEC(NIL.STR,3)
;MUTL.N.G => N.L + 1 => MUTL.N.G
;TL.PL(%40 ! R, NL)
;-1=>T.AP.G
@BOX 6.1
;1 => IN.LOG.IF.G
;PROCESS.STATEMENT(STAT.NO)
;TL.LABEL(N.L)
@BOX 10.1
;END
@BOX 17.1
;8+>R
;IF STAT.NO = 13
@BOX 12.1
;INV.COND[R-9] => R
@BOX 19.1
;%9 => R
@BOX 20.1
;PLANT.BRANCH(%40 ! R,INT OF PROPS.T[AS[STAT.AP.G]])
@BOX 21.1
;FAULT(39,1)
@BOX 22.1
;FAULT(107,0-FSS)
@BOX 13.1
;FAULT(40,1)
@END
@TITLE FTN08.6(1,6)
@COL 1S-3R-4F
@FLOW 1-3-4
@BOX 1.0
BLOCK IF
@BOX 3.0
INCREMENT BLOCK NESTING
INITIALISE NESTING TABLE
INCREMENT BLOCK NUMBER
CODE BLOCK IF:8.17:
@BOX 4.0
END
@BOX 1.1
;PROC BLOCK.IF

@BOX 3.1
;0 => NEST.TBL[3+>CUR.NEST.LEV.G] => NEST.TBL[1+CUR.NEST.LEV.G]
;1+>CUR.BLOCK.NO.G => NEST.TBL[2+CUR.NEST.LEV.G]
;CODE.IF(AS[STAT.AP.G])
@BOX 4.1
;END
@END
@TITLE FTN08.7(1,6)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
ELSE IF
@BOX 2.0
CODE ELSE PART:8.18:
CODE IF PART:8.17:
@BOX 3.0
END
@BOX 1.1
;PROC ELSE.IF
@BOX 2.1
;CODE.ELSE()
;CODE.IF(AS[STAT.AP.G])
@BOX 3.1
;END
@END
@TITLE FTN08.8(1,6)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
ELSE
@BOX 2.0
PLANT ELSE CODE:8.18:
CLEAR ELSE LABEL IN IF TABLE
@BOX 3.0
END
@BOX 1.1
;PROC F.ELSE
@BOX 2.1
;CODE.ELSE()
;0 => NEST.TBL[CUR.NEST.LEV.G]
@BOX 3.1
;END
@END
@TITLE FTN08.9(1,6)
@COL 1S-20N-3T-4T-11R-6F
@COL 9R-5R
@ROW 5-11
@ROW 3-9
@FLOW 1-20-3N-4N-11-6
@FLOW 3Y-9-6
@FLOW 4Y-5-6
@BOX 1.0
END IF
@BOX 4.0
IS THE TOP LEVEL OF NESTING A DO LOOP?
@BOX 3.0
NESTING LEVEL =< 0?
@BOX 5.0
FAULT
@BOX 6.0
END
@BOX 9.0
FAULT
@BOX 11.0
PLANT POSSIBLE ELSE LABEL
PLANT POSSIBLE END IF LABEL
DECREMENT NESTING LEVEL
@BOX 1.1
;PROC END.IF
;$IN T,N
@BOX 4.1
;IF NEST.TBL[CUR.NEST.LEV.G+1] => N + (NEST.TBL[CUR.NEST.LEV.G] => T) = 0
@BOX 3.1
;IF CUR.NEST.LEV.G = < 0
@BOX 11.1
; IF N /= 0 THEN TL.LABEL(N) FI
;IF T /= 0 THEN TL.LABEL(T) FI
;3 -> CUR.NEST.LEV.G
@BOX 6.1
;END
@BOX 9.1
;FAULT(42,1)
@BOX 5.1
;FAULT(41,1)
@END
@TITLE FTN08.10(1,11)
@COL 1S-3R-4T-5T-6T-7T-8T-19T-9T-10R-11R-12R-22F
@COL 27R-29R-20T-21R-30R-23R-31T-32R-33N
@ROW 6-27
@ROW 12-33
@FLOW 1-3-4N-5-6N-7N-8N-19N-9N-10-11-12-22
@FLOW 4Y-33
@FLOW 5Y-27-33-22
@FLOW 6Y-29-20N-21-11
@FLOW 7Y-31N-32-11
@FLOW 8Y-23-33
@FLOW 9Y-30-11
@FLOW 31Y-10
@FLOW 19Y-21-11
@FLOW 20Y-11
@BOX 1.0
DO
@BOX 3.0
INITIALISE DO TABLE ENTRY
BUT DO NOT ALLOCATE IT
ADVANCE NESTING LEVEL
ADVANCE BLOCK NUMBER
INITIALISE NESTING TABLE
@BOX 4.0
CHECK IMPLICIT
DECLARATION:6.5:
INVALID?
@BOX 5.0
IS CONTROL VAR NOT SCALAR
OR NOT ARITHMETIC TYPE?
@BOX 6.0
VARIABLE NON SCALAR
OR INCORRECT TYPE ?
@BOX 6.0
INCR PARAM ABS?
@BOX 7.0
EVALUATE INCR PARAM:8.19:
VARIABLE INCR?
@BOX 8.0
VALUE ZERO?
@BOX 9.0
INCR INT OR
SIMPLE REAL/D.P
CONSTANT?
@BOX 10.0
NOTE TRIP COUNT USED
UPDATE DO TABLE
@BOX 11.0
EVALUATE TERM PARAM:8.19:
EVALUATE START PARAM:8.19:
CODE LOOP BODY :8.10.1:
@BOX 12.0
ALLOCATE DO ENTRY
ADD LABEL TO DO TABLE
MARK CONTROL VAR AS A LOOP VAR
@BOX 19.0
INTEGER VARIABLE
NOT DUMMY ARGUMENT
AND UNIT VALUE
and not 66?
@BOX 20.0
INTEGER VARIABLE
NOT DUMMY ARGUMENT
OR 66?
@BOX 21.0
NOTE SPECIAL LOOP
@BOX 22.0
END
@BOX 23.0
FAULT
@BOX 27.0
FAULT
@BOX 29.0
SET INCR PARAM TO BE
CONSTANT VALUE 1 OF
CORRECT TYPE
@BOX 30.0
NOTE SIGN OF CONST
@BOX 31.0
INCR NOT INTEGER?
@BOX 32.0
PLANT EXTRACT SIGN
SAVE IN MULT
@BOX 1.1
;PROC F.DO
;$IN D,CN,AP,LT,F,S,SN,I,TRIP.N
;$IN32 L
;ADDR LABEL.PROP SP
;ADDR LOCAL.PROP DO.LP
;ADDR CONST.PROP CP
;LITERAL/ADDR $IN NIL.16=
;LITERAL/ADDR CONST.PROP NIL.CP=
;LITERAL/ADDR [$LO8]  NIL.STR =
;$IN L1,L2,EL,LL
;DATAVEC COMPARE($LO8)
%4C %4E
END
;0 => TRIP.N
@BOX 3.1
;SELECT DO.T[DO.PTR.G]
;0=>SIGN=>NEST.TBL[3+>CUR.NEST.LEV.G => CN]
   => NEST.TBL[1+CN]
;1+>CUR.BLOCK.NO.G => NEST.TBL[2+CN]
@BOX 4.1
;LOC OF PROPS.T[AS[STAT.AP.G=>AP+1]] => DO.LP
;IF CHECK.IMPLICIT.DECL(DO.LP) /= 0
@BOX 5.1
;IF L.KIND OF DO.LP^ /=1 OR L.TYPE OF DO.LP^ => LT
   =2 OR LT > 3
@BOX 6.1
;LT=>DO.TYPE.G
;L.LEN OF DO.LP^ => DO.LEN.G
;IF AS[AP+4] = -1
@BOX 7.1
;IF EVALUATE.DO.PARAM(AP+4,^INC,0) => CP = NIL.CP
@BOX 8.1
;0 => F => I => R.G => D.G
;IF LT=3 THEN
   ;IF INT.CONST OF CP^ => I = 0 THEN
      ;1 => F
   ;FI
;ELSE IF LT = 0 THEN
   ;IF REAL.CONST OF CP^ => R.G = 0. THEN
      ;1 => F
   ;FI
;ELSE IF D.P.CONST OF CP.^ => D.G = 0. THEN
      ;1 => F
;FI FI FI
;IF F /=0
@BOX 9.1
;IF LT=3 OR R.G=1. OR R.G= -1. OR
    D.G=1. OR D.G= -1.
@BOX 10.1
;-1 => TRIP.N
@BOX 11.1
;EVALUATE.DO.PARAM(AP+3,^TERM,SIGN)
;EVALUATE.DO.PARAM(AP+2,NIL.16,0)
#FTN08.10.1
@BOX 27.1
;FAULT(44,1)
@BOX 29.1
;-1 => SIGN
;TL.ONE.G=>INC
; 1 => I
@BOX 30.1
;IF I < 0 OR R.G < 0. OR D.G < 0. THEN
   ;0 => SIGN
;ELSE
   ;-1 => SIGN
;FI
@BOX 31.1
;IF LT /= 3
@BOX 32.1
;V.DECL(LT,L.LEN OF DO.LP^ => LL,0) => SIGN
;SET.A.TYPE(LT,LL)
;TL.PL(%22,INC)
;TL.PL(%2F,TL.ZERO.G)
;TL.LABEL.SPEC(NIL.STR,3)
;TL.LABEL.SPEC(NIL.STR,3)
;MUTL.N.G => L1 +1 => L2 +1 => MUTL.N.G
;TL.PL(%4B,L1)
;TL.C.LIT.16(%44, -1)
;TL.PL(%22,0)
;TL.PL(%20,SIGN)
;TL.PL(%4F,L2)
;TL.LABEL(L1)
;TL.PL(%22,TL.ONE.G)
;TL.PL(%20,SIGN)
;TL.LABEL(L2)
@BOX 23.1
;FAULT(45,1)
@BOX 12.1
;IF INT OF PROPS.T[AS[AP]] => L => DO.LAB < 100000 THEN
     PROCESS.STAT.REF(%20,L) FI
;%400 !> LSPECS OF  DO.LP^
;DO.LP => CV
;1+>DO.PTR.G
@BOX 19.1
;IF LT = 3 AND [I=1 OR I= -1]
  AND L.SPECS OF DO.LP^ & %200 = 0
   AND INFORM.LINE.G & LOOP.66.BIT.L = 0
@BOX 20.1
; IF LT /= 3 OR L.SPECS OF DO.LP^ & %200 /= 0
     OR INFORM.LINE.G & LOOP.66.BIT.L /= 0
@BOX 21.1
; (IF I = -1 THEN 2 ELSE 1) => TRIP.N
@BOX 22.1
;END
@END
@TITLE FTN08.10.1(1,11)
@COL 16R-6T-7R-8R
@COL 1S-4T-14R-15T-17T-18T-19R-2F
@COL 3R-21R-5N
@ROW 16-17
@ROW 19-21
@ROW 14-3
@FLOW 1-4N-14-15N-17N-18N-19-2
@FLOW 15Y-16-6N-7-8-2
@FLOW 18Y-21-5-2
@FLOW 4Y-3-5
@FLOW 17Y-2
@FLOW 6Y-8-2
@BOX 1.0
CODE LOOP BODY
@BOX 2.0
END
@BOX 3.0
TL.CV.CYCLE
TL.CV.LIMIT
@BOX 4.0
INTEGER LOOP WITH
UNIT CONSTANT ARGUMENTS
@BOX 14.0
PLANT SAVE ACC IN LOOP VAR :11.23:
@BOX 15.0
TRIP NEEDED?
@BOX 16.0
PLANT REVERSE SUB TERM
PLANT ADD INCR
PLANT DIV INCR
PLANT ACONV INT
@BOX 6.0
FORTRAN 77?
@BOX 7.0
ENSURE IT LOOPS ONCE
@BOX 8.0
TL.CYCLE
@BOX 17.0
FORTRAN 66?
@BOX 18.0
DECLARE AND PLANT LOOP LABEL(IF NO TRIP NEEDED)
UPDATE DO TABLE
DECLARE END LABEL
SIGN USED?
@BOX 19.0
PLANT ACC COMP TERM
PLANT IF(SIGN), -> END.LABEL
@BOX 21.0
PLANT ACC * MULT
PLANT ACC COMP TERM
PLANT IF >, -> END.LABEL
@BOX 3.1
;TL.CV.CYCLE(L.TL.NAME OF DO.LP^,%3000,TRIP.N)
;TL.CV.LIMIT(TERM)
;0 => LOOP.ST => LOOP.END
@BOX 4.1
;IF TRIP.N > 0
@BOX 14.1
;TL.REG(2)
;PL.VAR.OP(%20,DO.LP)
@BOX 15.1
;IF TRIP.N /= 0
@BOX 17.1
;TL.LABEL.SPEC(NIL.STR,3)
;TL.LABEL(MUTL.N.G => LOOP.ST)
;1 +> MUTL.N.G
;-1 => LOOP.END
;IF INFORM.LINE.G & LOOP.66.BIT.L /= 0
@BOX 18.1
;TL.LABEL.SPEC(NIL.STR,3)
;MUTL.N.G => EL => LOOP.END + 1 => MUTL.N.G
;IF SIGN > 0
@BOX 19.1
;TL.PL(%2F,TERM)
;TL.PL(COMPARE[0-SIGN],EL)
@BOX 21.1
;TL.PL(%2B,SIGN)
;TL.PL(%2F,TERM)
;TL.PL(%4E,EL)
@BOX 16.1
;TL.PL(%2A,TERM)
;TL.PL(%28,INC)
;TL.PL(%2C,INC)
;TL.PL(%45,I.ACC.T.L)
@BOX 6.1
; 1 => LOOP.END
;IF INFORM.LINE.G & LOOP.66.BIT.L = 0
@BOX 7.1
;TL.LABEL.SPEC(NIL.STR,3)
;MUTL.N.G => EL + 1 => MUTL.N.G
;TL.PL(%2F,TL.ZERO.G)
;TL.PL(%4E,EL)
;TL.PL(%22,TL.ONE.G)
;TL.LABEL(EL)
@BOX 8.1
;TL.CYCLE(%3000)
; 0 => LOOP.ST
@END
@TITLE FTN08.11(1,6)
@COL 1S-2F
@FLOW 1-2
@BOX 1.0
CONTINUE
@BOX 2.0
END
@BOX 1.1
;PROC FCONTINUE
@BOX 2.1
;END
@END
@TITLE FTN08.12(1,7)
@COL 1S-2T-3R-4R-5R-7F
@COL 6R
@ROW 3-6
@FLOW 1-2NO-3-4-5-7
@FLOW 2YES-6-4
@BOX 1.0
STOP
PAUSE(AP)
@BOX 2.0
SELECT APPROPIATE
STOP PAUSE PROCEDURE
PLANT STACK LINK:11.22:
STOP WITH PAGE.LINE PARAMETER
@BOX 3.0
STACK PARAM FROM A/R
@BOX 4.0
PLANT CALL TO STOP/PAUSE
@BOX 5.0
IF STOP AND NEXT LABEL ABSENT
 AND NOT IN LOGICAL IF
  NOTE NO DROP THROUGH FLOW TO
  NEXT STATEMENT
@BOX 7.0
END
@BOX 6.0
STACK PAGE LINE AS PARAM
@BOX 1.1
;PROC FSTOPAUSE(AP)
;$IN T,K,AD,F
;ADDR [$LO8] VB
@BOX 2.1
;IF AP=>F /= 0 THEN
  ;AS[AP]=>F
;FI
;PL.STK.LB(F+FIO.F.STP,0)
;IF F & 1 = 0
@BOX 3.1
;TL.PL(%46,%83)
;TL.PL(%21,DECL.CHAR.CONST(AS[AP+1]))
;TL.PL(%41,%3000)
@BOX 4.1
;-1 => CUR.A.TYPE.G
;TL.PL(%42,0)
@BOX 5.1
;IF F < 2 AND NEXT.ST.LABEL.G = 0
    AND IN.LOG.IF.G /= 1 THEN
   ;2 => JUMPED.G
;FI
@BOX 7.1
;END
@BOX 6.1
;TL.PL(%46,%4C)
;TL.C.LIT.32(%4C,CUR.LIN.PAG.G)
;TL.PL(%22,0)
;TL.PL(%41,%3000)
@END
@TITLE FTN08.13(1,11)
@COL 5R-7R
@COL 1S-28R-3R-2T-4T-6T-30R-8R-10T-19R
@COL 24T-25R-26R-9R-20F
@ROW 5-6
@ROW 4-24
@ROW 11-9
@FLOW 1-28-3-2N-4Y-5-6Y-7-30-8-10N-19-9-20
@FLOW 2Y-24N-25-26-9
@FLOW 4N-6
@FLOW 6N-30
@FLOW 24Y-26
@FLOW 10Y-26
@BOX 1.0
END
@BOX 2.0
BLOCK DATA?
@BOX 30.0
COMPLETE ARG SPECIFICATION FOR ALL ENTRIES TO PU
CHECK ENTRY SPECS FOR CONSISTENCY
PLANT EXIT SUBPROGRAM :8.13.1:
@BOX 28.0
OUTPUT ANY REQUESTED
DEBUG PRINTING
@BOX 3.0
SCAN ALL COMMONS AND
RESET COMMON ENTRIES
@BOX 4.0
CONTAINS NO
EXEC STATS?
@BOX 5.0
WARNING
@BOX 6.0
ANY IF BLOCKS
INCOMPLETE?
@BOX 7.0
FAULT
@BOX 19.0
PLANT END OF PROC
@BOX 20.0
END
@BOX 10.0
MAIN PROGRAM UNIT
@BOX 11.0
TRANSFER MUTL NAMES OF
ANY PROC SPECS DECLARED IN THIS PU
TO ENCLOSING BLOCK
@BOX 24.0
DATA INIT PRESENT
@BOX 25.0
WARNING
@BOX  26.0
END MUTL BLOCK
@BOX 8.0
LABEL PROCESSING:8.13.2:
@BOX 9.0
RESET MUTL NAME
RESET LOCAL HASH TABLE
RESET LABEL HASH TABLE
RECOVER LOCAL SPACE
SET PU TO UNDEFINED
@BOX 1.1
;PROC F.END
;LITERAL/ADDR[$LO8] NIL.STR=
;$IN NN,P,IN
;ADDR GLOBAL.PROP GP
;LITERAL/ADDR GLOBAL.PROP NIL.GP=
;ADDR LOCAL.PROP LP,LP1,D.LP,D.LP1
;ADDR COMMON.PROP CP
;LITERAL/ADDR COMMON.PROP NIL.CP =
;LITERAL/ADDR LOCAL.PROP NIL.LP =
;ADDR LABEL.PROP SP
;LITERAL/ADDR LABEL.PROP NIL.SP =
;ADDR[$LO8] AE
;$IN I,N,D1,T,LK,TY,TL.N
@BOX 3.1
;COM.LIST.G => CP
;WHILE CP /= NIL.CP DO
   ;NIL.LP => C.HEAD OF CP^
      => C.TAIL OF CP^
   ;%6E &> C.KIND OF CP^
;C.PREV.P OF CP^ => CP
;OD
@BOX 2.1
;IF PU.G = 1
@BOX 28.1
;IF DEBUG.PU.G /=0 THEN
    ;MONITOR(DEBUG.PU.G)
;FI
@BOX 4.1
;IF EXEC.ST.CNT.G =< 1
@BOX 5.1
;FAULT(%12E,1)
@BOX 6.1
;IF CUR.NEST.LEV.G /= 0
@BOX 7.1
;FAULT(47,1)
@BOX 19.1
;TL.END.PROC()
@BOX 20.1
;END
@BOX 24.1
;IF DATA.ST.CNT.G > 0
@BOX 9.1
; PU.START.MUTLN.G => MUTLN.G
;-1 => I
;WHILE 1+>I < LOCAL.HASH.Z.L DO
       ;NIL.LP => L.HASH[I]
;OD
-1=> I
;WHILE 1+>I < LABEL.HASH.Z.L DO
       ;NIL.SP => S.HASH[I]
;OD
;RESET.SPACE(LOCAL.SPACE)
;4=>PU.G
@BOX 10.1
;IF PU.G = 0
@BOX 25.1
;FAULT(%12E,1)
@BOX 26.1
;TL.END.BLOCK()
@BOX 8.1
#FTN08.13.2
@BOX 30.1
#FTN08.13.1
@END
@TITLE FTN08.13.1(1,11)
@COL 1S-15T-30R-3T-18R-2R-5F
@COL 4T-27R
@ROW 3-4
@ROW 27-18
@FLOW 1-15N-30-3N-18-2-5
@FLOW 15Y-4N-27-2
@FLOW 3Y-2
@FLOW 4Y-2
@BOX 1.0
@BOX 2.0
RESET JUMPED INDICATOR
@BOX 3.0
END NOT ON CONTROL FLOW
@BOX 4.0
END NOT ON CONTROL FLOW
@BOX 5.0
END
@BOX 15.0
MPU?
@BOX 27.0
PLANT STOP
@BOX  18.0
PLANT RETURN
@BOX 30.0
COMPLETE ARG SPECIFICATION FOR ALL ENTRIES TO PU
DEFINE VARIABLE FOR HANDLING
VARIABLE LENGTH VALUE SIZED ARGUMENTS
CHECK ENTRY SPECS FOR CONSISTENCY:6.2:
UPDATE GLOBAL PROPERTIES
@BOX 3.1
;IF JUMPED.G = 2 AND CURRENT.LABEL.G =< 0
@BOX 4.1
;IF JUMPED.G = 2 AND CURRENT.LABEL.G =< 0
@BOX 2.1
;0 => JUMPED.G
@BOX 5.1
::END
@BOX 30.1
;L.CUR.PU => LP
;WHILE LP /= NIL.LP DO
   ;L.ARG.SPEC.P OF LALT OF LP^ => AE
   ;L.LINK.1 OF LP^ => D.LP  ;0 => I
   ;0 => TL.N
   ;ADD.G.NAME(^L.NAME OF LP^) => GP => F.G.PROP.G
   ;WHILE D.LP /= NIL.LP DO
      ;WHILE AE^[2+>I] & 7 = 6 DO OD
      ;D.LP => D.LP1
      ;IF L.LINK2 OF D.LP^ /= NIL.LP THEN
         ;L.LINK2 OF D.LP^ => D.LP1
      ;FI
      ;IF L.KIND OF D.LP1^ => LK = 2 THEN
           ;%48 => T
      ;ELSE IF LK = 1 THEN
           ;%28 => T
      ;ELSE IF LK > 3 THEN
           ;%18 => T
      ;ELSE
           ;%38 => T
      ;FI  FI  FI
      ;L.TYPE OF D.LP1^ => TY ! T => AE^[I]
      ;IF [TY = 3 OR TY=4] AND LK=1 THEN
         ;GET.AREA(0, I.PARAM.Z)
         ;TL.I.PARAM(G.TL.NAME OF GP^,TL.N,
         MUTL.TYPE(TY, L.LEN OF DLP1^) ! %4001)
       FI
      ;IF TY = 5 THEN
          2 +> TL.N
         ;0 => T
       ELSE
          1 +> TL.N
         ;L.LEN OF DLP1^=>T
       FI
      ;T => AE^[I+1]
      ;L.LINK.1 OF D.LP^ => D.LP
   ;OD
   ;IF G.ARG.SPEC.P OF GP^ = NIL.STR THEN
      ;AE => G.ARG.SPEC.P OF GP^
   ;ELSE
      ;CHECK.SPECS(G.ARG.SPEC.P OF G.P^,AE)
   ;FI
   ;L.LINK2 OF LP^ => LP
;OD
@BOX  15.1
;IF PUG = 0
@BOX 27.1
;FSTOPAUSE(0)
@BOX 18.1
;AS[STAT.AP.G]=>T
;-1=>AS[STAT.AP.G]
;RETURN()
;T=>AS[STAT.AP.G]
@END
@TITLE FTN08.13.2(1,10)
@COL 1S-13R-3T-4R-5T-7T-8R-9T-11N-12F
@COL 6R-10R
@ROW 7-6
@ROW 11-10
@FLOW 1-13-3N-4-5N-7N-8-9N-11-12
@FLOW 3Y-7Y-11
@FLOW 5Y-6-12
@FLOW 9Y-10-12
@BOX 1.0
LABEL PROCESSING
@BOX 13.0
REPORT ANY LABELS
NOT DEFINED
@BOX 3.0
ASSIGNED GOTO WITH LABEL VECTORS
NOT NEEDED IN THIS UNIT
@BOX 4.0
GENERATE LABEL VECTOR
@BOX 5.0
NO LABELS FOUND?
@BOX 6.0
FAULT
@BOX 7.0
FORMAT DICT NOT NEEDED?
@BOX 8.0
INITIALISE FORMAT DICT
@BOX 9.0
NO LABELS FOUND?
@BOX 10.0
FAULT
@BOX 12.0
END
@BOX 13.1
;-1 => I
;WHILE 1+>I < LABEL.HASH.Z.L DO
   ;S.HASH[I] => S.P
   ;WHILE S.P /= NIL.SP DO
   ;IF S.KIND OF S.P^ & %10 = 0 THEN
      ;SP => F.S.PROP.G
      ;FAULT(48,3)
   ;FI
   ;S.NEXT.P OF SP^ => SP
   ;OD
;OD
@BOX 3.1
; IF ASS.GOTO.VEC.NAME.G = 0
@BOX 4.1
; 0 => N
; TL.ASS(ASS.GOTO.VEC.NAME.G,-1)
; -1 => I
; WHILE 1 +> I < LABEL.HASH.Z.L DO
     ; S.HASH[I] => S.P
     ; WHILE S.P /= NIL.SP DO
          ; IF S.KIND OF S.P^ & %82 = %82 THEN
               TL.ASS.VALUE(S.TL.NAME OF S.P^,1)
               ; 1 => N
            FI
            ; S.NEXT.P OF SP^ => SP
      OD
 OD
; TL.ASS.END()
; TL.ASS(ASS.GO.TO.VEC.NAME.G+1,-1)
; -1 => I
; WHILE 1 +> I < LABEL.HASH.Z.L DO
   ; S.HASH[I] => S.P
   ;WHILE S.P /= NIL.SP DO
      ;IF S.KIND OF S.P^ & %82 = %82 THEN
         ; TL.C.LIT.16(%84, S.ID OF S.P^)
         ; TL.ASS.VALUE(0, 1)
      ; FI
      ; S.NEXT.P OF SP^ => SP
   ; OD
; OD
; TL.ASS.END()
@BOX 5.1
IF N = 0
@BOX 6.1
;FAULT(125,1)
@BOX 7.1
; IF FMT.DICT.NAME.G = 0
@BOX 8.1
; 0 => N
; TL.ASS(FMT.DICT.NAME.G,-1)
; -1 => I
; WHILE 1 +> I < LABEL.HASH.Z.L DO
     ; S.HASH[I] => S.P
     ; WHILE S.P /= NIL.SP DO
          ;IF S.KIND OF S.P^ & %84 = %84 THEN
              ; TL.C.LIT.16(%84, S.ID OF SP^)
              ; TL.ASS.VALUE(0, 1)
              ; TL.ASS.VALUE(S.TL.NAME OF S.P^ => N,1)
              ; TL.ASS.VALUE(N + 1,1)
           FI
         ; S.NEXT.P OF S.P^ => S.P
     OD
 OD
; TL.ASS.END()
@BOX 9.1
; IF N = 0
@BOX 10.1
; FAULT(126,1)
@BOX 12.1
@END
@TITLE FTN08.14(1,11)
@COL 19R-20R-15R-23N
@COL 1S-16T-17T-21T-18T-5N-3T-4N-8T-9R-2T-10T-11R-12R-13R-14R-6F
@COL 22N-7R
@ROW 17-19
@ROW 15-4
@ROW 2-22
@ROW 20-5
@ROW 23-10
@FLOW 1-16N-17N-21N-18N-5-3-4-8N-9-2NO-10N-11-12-13-14-6
@FLOW 2YES-22-7-6
@FLOW 16Y-19-23
@FLOW 17Y-22
@FLOW 21OTHERS-22
@FLOW 18Y-20-3
@FLOW 3Y-15-8
@FLOW 10Y-23-6
@FLOW 8Y-2
@BOX 1.0
CALL
@BOX 3.0
IF KIND IS UNDEFINED
THEN SET ENTITY KIND TO SUBROUTINE
AND SET TL.TYPE IF DUMMY ARG
CALLING ENCLOSING SUBROGRAM?
@BOX 15.0
FAULT
@BOX 2.0
REDUCE EXPR:11.1:
EXPR NOT A SUBROUTINE REFN
@BOX 6.0
END
@BOX 7.0
FAULT
@BOX 10.0
CODE CALL:11.2:
COUNT NO OF DUMMY ARGUMENTS
IN ARGUMENT LIST
NO ARGUMENTS?
@BOX 11.0
DECLARE NO SWITCH LABEL
SET RTYPE TO INT 16
PLANT A=>B
PLANT IF B OUT OF RANGE
->NO SWITCH
@BOX 12.0
DECLARE A SWITCH VECTOR
PLANT D = REF SWITCH
SEL EL
-> D[]
@BOX 13.0
ASSIGN LABELS TO SWITCH
AND PROCESS STATEMENT LABEL
REFERENCE
@BOX 14.0
DEFINE NO SWITCH LABEL
@BOX 8.0
OPERAND HAS AN ARGUMENT LIST
@BOX 9.0
CREATE A NIL ARGUMENT LIST
@BOX 16.0
CALL OPERAND NOT AN
UNDEFINED EXPR NODE
@BOX 17.0
CALL OPERAND CANNOT BE A SUBROUTINE
@BOX 18.0
CALL OPERAND EXPLICITLY TYPED
@BOX 19.0
FAULT
@BOX 20.0
WARNING
@BOX 21.0
CALL OPERAND ONLY ALLOWED IN
CALL AND SUBROUTINE STATEMENTS
@BOX 1.1
;PROC CALL
;LITERAL/ADDR LABEL.PROP NIL.SP =
;LITERAL/ADDR [$LO8]NIL.STR =
;ADDR LABEL.PROP SP
;ADDR LOCAL.PROP LP
;$IN E,Z,LK,T,AP,N,Z1,AP1,AP2,LAB,LS
@BOX 3.1
  ;IF LK  = 0 OR LK = 8  THEN
   ;IF LK=0 AND LS&%200 /=0 THEN
     ;TL.SET.TYPE(L.TL.NAME OF LP^,%24) FI
    ;5=>L.KIND OF LP^
    ;NIL.STR => L.ARG.SPEC.P OF L.ALT OF LP^
;FI
; 7 => L.TYPE OF LP^
; IF LS & %800 /= 0
@BOX 8.1
IF T & %410 /= %10
@BOX 9.1
;T ! %400 =>AS[E]
;0=>AS[STAT.AP.G+2=>AS[E+4]]
@BOX 2.1
;IF REDUCE.EXPR(E) = -1 THEN EXIT FI
;IF AS[E] & %1F /= %15
@BOX 6.1
;END
@BOX 7.1
;LP => F.L.PROP.G
;FAULT(49,1)
@BOX 10.1
;CODE.EXPR(E,%22)
;AS[AS[E+4]=>AP1=>AP]=>Z=>Z1
;0 => N
;WHILE 1-> Z > = 0 DO
   ;IF AS[AS[1+>AP]]& %1F = %1A THEN
      ;1+> N
   ;FI
;OD
;IF N = 0
@BOX 11.1
;TL.LABEL.SPEC(NIL.STR,3)
; SET.B.TYPE (1)
;TL.PL(%02,%3000)
;TL.REG(1)
;TL.PL(%F,TL.ZERO.G)
;TL.PL(%4C,MUTL.N.G)
;TL.C.LIT.16(%44,N)
;TL.REG(1)
;TL.PL(%F,0)
;TL.PL(%4B,MUTL.N.G)
@BOX 12.1
;TL.S.DECL(NIL.STR,%2C ,-1)
;TL.PL(%61,MUTL.NG+1)
;TL.PL(%64,0)
;TL.PL(%4F,%1004)
@BOX 13.1
;TL.ASS(MUTL.N.G+1,-1)
;MUTL.NG =>LAB + 2 => MUTL.N.G
;WHILE 1->Z1 > = 0 DO
    ;IF AS[AS[1+>AP1]=>AP2] & %1F = %1A THEN
        PROCESS.STAT.REF(2,AS[AP2+2]) => S.P
        ;IF S.P /= NIL.SP THEN
           ;TL.ASS.VALUE(S.TL.NAME OF S.P^,1)
        ;FI
    ;FI
;OD
;TL.ASS.END()
@BOX 14.1
;TL.LABEL(LAB)
@BOX 15.1
;FAULT(128,1)
@BOX 16.1
;IF AS[AS[STAT.AP.G]=>E]=>T & %1F /= %1F
@BOX 17.1
;LOC OF PROPS.T[AS[E+2]] => LP => FLPROPG
;IF L.KIND OF LP^ => LK /= 0 /= 5 /= 8
@BOX 18.1
;IF LS & %80 /= 0
@BOX 19.1
;FAULT(49,6)
@BOX 20.1
;FAULT(397,1)
@BOX 21.1
;IF L.SPECS OF LP^ => LS & %57D /= 0
@END
@TITLE FTN08.15(1,11)
@COL 12R
@COL 1S-2T-3T-6T-7R-8T-9R-10R-16T-11R-5F
@COL 13R-14T-15R-20T-4R-18R-21R-19N
@ROW 3-13
@ROW 12-9
@ROW 10-19
@FLOW 1-2N-3N-6N-7-8N-9-10-16N-11-5
@FLOW 2Y-13-19-16Y-5
@FLOW 3Y-14N-15-20N-4-10
@FLOW 20Y-21-10
@FLOW 14Y-20
@FLOW 6Y-12-10
@FLOW 8Y-18-19
@BOX 1.0
RETURN
@BOX 2.0
IN MPU?
@BOX 3.0
IN FUNCTION
@BOX 4.0
PLANT A = RESULT
@BOX 6.0
EXPR NOT PRESENT?
@BOX 7.0
ADD -1 TO AR
@BOX 8.0
REDUCE.EXPR:11.2:
INVALID EXPR
@BOX 9.0
CODE.EXPR:11.3:
CONVERT ACC TO I16
IF NECESSARY
@BOX 10.0
PLANT RETURN
@BOX 11.0
NOTE NO DROP THROUGH FLOW TO
NEXT STATEMENT
@BOX 5.0
END
@BOX 12.0
PLANT A =  -1
@BOX 13.0
FAULT
@BOX 14.0
EXPR ABSENT?
@BOX 15.0
FAULT
@BOX 16.0
NEXT LABEL PRESENT OR IN LOGICAL IF?
@BOX 18.0
FAULT
@BOX 20.0
CHAR FUNCTION?
@BOX 21.0
NOTE NO RESULT
@BOX 1.1
;PROC RETURN
;$IN E, P, OP,T
;ADDR CONST.PROP CP
;%3000 =>OP
@BOX 2.1
;IF PU.G = 0
@BOX 3.1
;IF PU.G = 3
@BOX 4.1
;SET.A.TYPE(T,L.LEN OF L.CUR.PU^)
;TL.PL(%22,L.TL.NAME OF L.CUR.PU^)
@BOX 6.1
;IF AS[STAT.AP.G] => E < 1
@BOX 7.1
;%9 => AS[END.AP.G=>P]
;E => AS[P+1]
;P + 3 => AS[P+2]
;ADD.CONST(0) => C.P
;1 => INT.CONST OF C.P^
;%3010 => AS[P+3]
;0 => AS[P+4]
;CP => CONST OF PROPS.T[1+>PROPS.I]
;PROPS.I => AS[P+5]
;AS[E+3] => AS[P+6]
; 7 +> END.AP.G
@BOX 8.1
;IF REDUCE.EXPR(P) & %F /= 3
@BOX 9.1
;CODE.EXPR(P,%22)
;IF AS[P] ->> 5 & 7 /= 1 THEN
    SET.A.TYPE(%13,1) FI
@BOX 10.1
;TL.PL(%43,OP)
@BOX 11.1
;2 => JUMPED.G
@BOX 5.1
;END
@BOX 12.1
;SET.A.TYPE(3,1)
;TL.PL(%21,TL.ONE.G)
@BOX 13.1
;FAULT(50,1)
@BOX 14.1
;IF AS[STAT.AP.G] < 0
@BOX 15.1
;FAULT(37,1)
@BOX 16.1
;IF NEXT.ST.LABEL.G /= 0 OR IN.LOG.IF.G = 1
@BOX 18.1
;FAULT(38,1)
@BOX 20.1
;IF L.TYPE OF L.CUR.PU^ => T = 5
@BOX 21.1
; 0=> OP
@END
@TITLE FTN08.16(1,6)
@COL 1S-4T-2R-3F
@COL 5R
@ROW 2-5
@FLOW 1-4N-2-3
@FLOW 4Y-5-3
@BOX 1.0
PROC PLANT BRANCH(FN,LABEL)
@BOX 2.0
PLANT(FN,PROCESS STAT REF(EXEC,LABEL)):8.20:
@BOX 4.0
LABEL = NEXTLABEL ?
@BOX 5.0
WARNING
@BOX 3.0
END
@BOX 1.1
;PROC PLANT.BRANCH(FN,L)
;ADDR LABEL.PROP LP
@BOX 4.1
;IF L = NEXT.ST.LABEL.G
@BOX 2.1
;PROCESS.STAT.REF(2,L) => LP
;TL.PL(FN,S.TL.NAME OF LP^)
@BOX 3.1
;END
@BOX 5.1
;FAULT(%122,1)
@END
@TITLE FTN08.17(1,6)
@COL 1S-2T-3T-4R-5R-6F
@COL 8R-7R
@ROW 3-8
@ROW 4-7
@FLOW 1-2N-3N-4-5-6
@FLOW 2Y-8-5
@FLOW 3Y-7-5
@BOX 1.0
PROC CODE IF
@BOX 2.0
REDUCE.EXPR:11.2:
IF NOT A LOGICAL EXPR?
@BOX 3.0
CODE.EXPR:11.3:
RESULT IN T BITS
@BOX 4.0
PLANT ACC COMP 1
SET JUMP COND TO IF /= 0
@BOX 8.0
FAULT
@BOX 5.0
DEFINE ELSE LABEL
UPDATE NESTING TABLE
PLANT IF COND, -> LABEL
@BOX 6.0
END
@BOX 7.0
GET JUMP COND AND REVERSE IT
@BOX 1.1
;PROC CODE.IF(AP)
;$IN C,N
;LITERAL/ADDR[$LO8] NIL.STR =
;DATAVEC REV.C($LO8)
%A  9  %C  %B  %E  %D
END
@BOX 2.1
;IF REDUCE.EXPR(AP) & %F /= 4
@BOX 3.1
;IF CODE.EXPR(AP,%22) => C > 0
@BOX 4.1
;TL.C.LIT.16(%80,1)
;TL.PL(%2F,0)
;%A => C
@BOX 8.1
;FAULT(33,1)
; %F => C
@BOX 7.1
;REV.C[C-1] => C
@BOX 5.1
;TL.LABEL.SPEC(NIL.STR,3)
;MUTL.N.G => NEST.TBL[CUR.NEST.LEV.G] => N + 1 => MUTL.N.G
;TL.PL(%40 ! C,N)
@BOX 6.1
;END
@END
@TITLE FTN08.18(1,6)
@COL 1S-3T-4T-5R-6R-7F
@COL 10R
@ROW 4-10
@FLOW 1-3N-4N-5-6-7
@FLOW 3Y-10-7
@FLOW 4Y-6
@BOX 1.0
PROC CODE ELSE
@BOX 3.0
IS THE TOP LEVEL OF NESTING A DO LOOP
OR HAS THERE ALREADY BEEN AN ELSE?
@BOX 4.0
INCREMENT BLOCK NUMBER
IS END IF LABEL DEFINED?
@BOX 5.0
DEFINE END LABEL
UPDATE NESTING TABLE
@BOX 6.0
PLANT JUMP TO END IF
PLANT ELSE LABEL
@BOX 7.0
END
@BOX 10.0
FAULT
@BOX 1.1
;PROC CODE.ELSE
;$IN N,E
;LITERAL/ADDR [$LO8] NIL.STR=
@BOX 3.1
;IF NEST.TBL[CUR.NEST.LEV.G] => E = 0
@BOX 4.1
;1 +> CUR.BLOCK.NO.G => NEST.TBL[CUR.NEST.LEV.G+2]
;IF NEST.TBL[CUR.NEST.LEV.G+1] => N /= 0
@BOX 5.1
;TL.LABEL.SPEC(NIL.STR,3)
;MUTL.N.G => N => NEST.TBL[CUR.NEST.LEV.G+1] + 1 => MUTL.N.G
@BOX 6.1
;TL.PL(%4F,N)
;TL.LABEL(E)
@BOX 7.1
;END
@BOX 10.1
;FAULT(51,1)
@END
@TITLE FTN08.19(1,11)
@COL 9R
@COL 1S-2T-3T-4R-5T-13T-14R-6R-7F
@COL 8R-10T-11R-12R
@ROW 9-4-8
@FLOW 1-2N-3N-4-5N-13N-14-6-7
@FLOW 2Y-9-7
@FLOW 3Y-8-10N-11-7
@FLOW 5Y-7
@FLOW 10Y-12-7
@FLOW 13Y-6
@BOX 1.0
EVALUATE DO PARAM(AR.PTR,DO.PAR,SIGN)CONST.PTR
CONST.PTR = NIL IF PARAM IS VARIABLE
@BOX 10.0
START DO PARAM
@BOX 11.0
UPDATE DO TABLE
@BOX 12.0
PLANT ACC=
@BOX 2.0
REDUCE.EXPR:11.1:
INVALID?
@BOX 3.0
CONSTANT EXPR
@BOX 4.0
CODE.EXPR:11.2:
PLANT ACONV IF NECESSARY
RESET A USE INFO
@BOX 5.0
START DO PARAM
@BOX 13.0
SIGN NOT USED?
@BOX 14.0
MULT BY SIGN
@BOX 6.0
DECLARE VARIABLE FOR DO PARAM
PLANT ACC =>
UPDATE DO TABLE
@BOX 7.0
END
@BOX 8.0
DECLARE CONSTANT
UPDATE DO TABLE
@BOX 9.0
FAULT
@BOX 1.1
;PROC EVALUATE.DO.PARAM(AP,P,SIGN)
;$IN ET,NP,T,N
;ADDR [$LO8] ML.STR
;ADDR CONST.PROP C.P
;LITERAL/ADDR [$LO8] NILSTR=
;LITERAL/ADDR $IN NIL.16=
;LITERAL/ADDR CONST.PROP NIL.CP =
@BOX 2.1
;NIL.CP => EVALUATE.DO.PARAM
;IF REDUCE.EXPR(AS[AP]=>NP) => ET & %F = 2 OR
    ET & %F > 3 OR ET & %1400 /= 0
@BOX 3.1
;%F &> ET
;IF AS[NP]=> T & %1F => T = %10 OR T = %11
@BOX 4.1
;CODE.EXPR(NP,%22)
;IF ET /= DO.TYPE.G OR AS[NP]->>5 &7 /= DO.LEN.G THEN
     SET.A.TYPE(%10!DO.TYPE.G,DO.LEN.G)
;FI
;-1=>A.AP.G=>B.AP.G
@BOX 5.1
;IF P = NIL.16
@BOX 13.1
;IF SIGN =< 0
@BOX 14.1
;TL.PL(%2B,SIGN)
@BOX 6.1
;TL.PL(%20,V.DECL(DO.TYPE.G,DO.LEN.G,0)=>P^)
@BOX 7.1
;END
@BOX 8.1
;CONST OF PROPS.T[AS[NP+2]]=>C.P=>EVALUATE.DO.PARAM
;IF ET /= DO.TYPE.G THEN
    ;IF T = %11 THEN
         ;COPY.CONST(C.P,0) => C.P
    ;FI
    ;CHANGE.CONST.TYPE(C.P,ET,DO.TYPE.G)
;FI
;DECL.ARITH.CONST(C.P,%10 ! DO.TYPE.G)
    => N
@BOX 10.1
;IF P = NIL.16
@BOX 11.1
;N => P^
@BOX 12.1
;SET.A.TYPE(DO.TYPE.G,DO.LEN.G)
;TLPL(%22,N)
@BOX 9.1
;FAULT(%2B,1)
@END
@TITLE FTN08.20(1,6)
@COL 21R-16R-17C
@COL 1S-2R-3T-25T-4T-5T-6R-7T-20T-8T-22T-9R-23T-24T-12R-13R-14F
@ROW 21-8
@ROW 16-9
@FLOW 1-2-3N(BACKWARD REF)-25N-4N-5N-6-13
@FLOW 25Y-21
@FLOW 3Y(FORWARD REF)-7N-20N-8N-22N-9-13
@FLOW 4Y-16
@FLOW 5Y-13
@FLOW 7Y-23N-24N-12-13-14
@FLOW 20Y-21-17
@FLOW 22Y-13
@FLOW 23Y-13
@FLOW 24Y-16
@FLOW 8Y-16-17
@BOX 1.0
PROCESS STAT REF(STATYPE,LABEL)LABEL PTR
@BOX 2.0
ADD.S.NAME => LABEL PROPTR:12.4:
@BOX 3.0
LABEL NOT DECLARED YET?
@BOX 25.0
DO LABEL?
@BOX 4.0
IS STATYPE INCONSISTENT?
@BOX 5.0
FORMAT STATEMENT OR
(LABEL NESTING LEVEL <= CURRENT NESTING LEVEL)
AND (LABEL BLOCK NUMBER = CURRENT BLOCK NUMBER [LABEL NESTING LEVEL])
@BOX 6.0
NON-STANDARD WARNING
@BOX 7.0
LABEL NEVER BEEN REFERENCED?
@BOX 20.0
DO LABEL?
@BOX 21.0
FAULT
@BOX 8.0
STAT TYPE INCONSISTENT?
@BOX 22.0
IF ASSIGNING?
@BOX 9.0
SAVE THE SMALLEST NESTING LEVEL
AND BLOCK NUMBER
@BOX 23.0
ASSIGNING OR
DO LABEL?
@BOX 24.0
PREVIOUSLY ASSIGNED
AND INCONSISTENTLY?
@BOX 12.0
DECLARE LABEL:8.20.1:
@BOX 13.0
RETURN LABEL PTR
@BOX 14.0
END
@BOX 15.0
FAULT
@BOX 16.0
FAULT
@BOX 17.0
RETURN
NIL PTR
@BOX 1.1
;PROC PROCESS.STAT.REF(TY,LAB)
;ADDR LABEL.PROP LP
;$IN K,B,L
;LITERAL/ADDR LABEL.PROP NIL.LP =
;LITERAL/ADDR[$LO8] NIL.STR =
@BOX 2.1
;ADD.S.NAME(LAB) => LP => F.S.PROP.G
;S.LEVEL OF LP^ => L
;S.BLOCK OF LP^ => B
@BOX 3.1
;IF S.KIND OF LP^ => K & %10 = 0
@BOX 25.1
;IF TY = %20
@BOX 4.1
; IF TY & K = 0
@BOX 5.1
;IF [TY & 4 /= 0] OR
    [L =< CUR.NEST.LEV.G AND
     NEST.TBL[L+2] = B]
@BOX 6.1
;FAULT(%135,3)
@BOX 7.1
;IF K & %40 = 0
@BOX 20.1
;IF TY = %20
@BOX 21.1
;FAULT(129,3)
@BOX 8.1
;IF K & TY = 0
@BOX 22.1
;IF TY&%80 /= 0
@BOX 9.1
;IF CUR.NEST.LEV.G < L THEN
    ;CUR.NEST.LEV.G => S.LEVEL OF LP^
;FI
;IF CUR.BLOCK.NO.G < B THEN
    ;CUR.BLOCK.NO.G => S.BLOCK OF LP^
;FI
@BOX 23.1
;IF TY & %A0 /= 0
@BOX 24.1
;IF S.TL.NAME OF LP^ = 0 AND K & %80 /= 0
        AND TY & 6 = 0
@BOX 12.1
#FTN08.20.1
@BOX 13.1
;LP => PROCESS.STAT.REF
@BOX 14.1
;END
@BOX 16.1
;FAULT(52,3)
@BOX 17.1
;NIL.LP =>
PROCESS.STAT.REF
;EXIT
@END
@TITLE FTN08.20.1(1,6)
@COL 18R
@COL 1S-10T-11R-12R-2F
@ROW 18-11
@FLOW 1-10N-11-12-2
@FLOW 10Y-18-12
@BOX 1.0
DECLARE LABEL
@BOX 2.0
END
@BOX 10.0
FORMAT?
@BOX 11.0
DEFINE LABEL
GET LABEL NAME
@BOX 12.0
CURRENT BLOCK NUMBER[CURRENT NESTING LEVEL] => REF BLOCK NUMBER
CURRENT NESTING LEVEL => REF NESTING LEVEL
SET REF TYPE
@BOX 18.0
MAKE MUTL NAMES FOR
FMT TABLE AND FMT STRINGS
@BOX 10.1
;IF TY & 4 /= 0
@BOX 11.1
;CR.LABEL.NAME(LAB)
;TL.LABEL.SPEC(^L.N.G,0)
;MUTL.N.G => S.TL.NAME OF LP^ + 1 => MUTL.N.G
@BOX 12.1
;NEST.TBL[CUR.NEST.LEV.G+2] => S.BLOCK OF LP^
;CUR.NEST.LEV.G => S.LEVEL OF LP^
;TY ! %40 => S.KIND OF LP^
@BOX 18.1
; TL.S.DECL(NIL.STR,FMT.TABLE.EL.TYPE.L,-1)
; TL.S.DECL(NIL.STR,%80,-1)
; MUTLN.G => S.TL.NAME OF LP^ +2 => MUTLN.G
@END
@TITLE FTN08.21(1,11)
@COL 1S-14T-2T-3T-4T-5R-6T-7R-8R-9F
@COL 15R-16C-30T-12R-10T-11R-17T-13R
@ROW 3-12
@ROW 14-15
@FLOW 1-14N-2N-3N-4N-5-6N-7-8-9
@FLOW 2Y-30N-12
@FLOW 30Y-10N-11-7
@FLOW 3Y-12-10
@FLOW 10Y-17N-13-8
@FLOW 17Y-8
@FLOW 6Y-8
@FLOW 4Y-6
@FLOW 14Y-15-16
@BOX 1.0
PROCESS STAT LABEL(STATYPE,LABEL PROPTR)
@BOX 2.0
HAS LABEL NEVER BEEN REFERENCED?
@BOX 3.0
IS STATYPE INCONSISTENT?
@BOX 4.0
FORMAT OR
((CURRENT NESTING LEVEL <= REF NESTING LEVEL)
AND(CURRENT BLOCK NUMBER[CURRENT NESTING LEVEL] <= REF BLOCK NUMBER))
@BOX 5.0
NON STANDARD WARNING
@BOX 6.0
NON-EXECUTABLE?
@BOX 7.0
DECLARE LABEL
@BOX 8.0
CLEAR REF CONTEXT
NOTE NEW CONTEXT
CURRENT NESTING LEVEL => LABEL NESTING LEVEL
CURRENT BLOCK NUMBER => LABEL BLOCK NUMBER
@BOX 9.0
END
@BOX 10.0
NON-EXECUTABLE?
@BOX 11.0
DEFINE LABEL
@BOX  30.0
NOT PREVIOUSLY ASSIGNED
OR TYPE CONSISTENT
@BOX 12.0
FAULT
@BOX 13.0
DECLARE FORMAT TABLE
@BOX 14.0
LABEL ALREADY DEFINED?
@BOX 15.0
FAULT
@BOX 16.0
END
@BOX 17.0
NOT FORMAT OR WITHIN DECLARATIONS?
@BOX 1.1
;PROC PROCESS.STAT.LABEL(TY,LP)
;$IN K
;LITERAL/ADDR[$LO8] NIL.STR =
@BOX 14.1
;LP => F.S.PROP.G
;IF S.KIND OF LP^ => K & %10 /= 0
@BOX 2.1
;IF K & %50 = 0
@BOX 15.1
;FAULT(119,3)
@BOX 16.1
;EXIT
@BOX 3.1
; IF K &TY = 0
@BOX 4.1
;IF TY &4 /= 0 OR
    [CUR.NEST.LEV.G =< S.LEVEL OF LP^ AND
     NEST.TBL[CUR.NEST.LEV.G+2] =< S.BLOCK OF LP^]
@BOX 5.1
;FAULT(%135,3)
@BOX 6.1
;IF TY /= 2
@BOX 7.1
;TL.LABEL(S.TL.NAME OF LP^)
@BOX 8.1
;%10 !> S.KIND OF LP^
;CUR.NEST.LEV.G => S.LEVEL OF LP^
;NEST.TBL[CUR.NEST.LEV.G+2] => S.BLOCK OF LP^
@BOX 9.1
;END
@BOX 10.1
;TY !> S.KIND OF LP^
;IF TY /= 2
@BOX 11.1
;CR.LABEL.NAME(S.NAME OF LP^)
;TL.LABEL.SPEC(^L.N.G,0)
;MUTLN.G => S.TL.NAME OF LP^ + 1 => MUTL.N.G
@BOX  30.1
;IF S.TL.NAME OF LP^ /= 0
  OR K & %80 = 0
  OR TY & 6 /= 0
@BOX 12.1
;FAULT(52,3)
@BOX 17.1
;IF TY /= 4 OR DONE.DECLARATIONS = 0
@BOX 13.1
; TL.S.DECL(NIL.STR,FMT.TABLE.EL.TYPE.L,-1)
; TL.S.DECL(NIL.STR,%80,-1)
; MUTLN.G => S.TL.NAME OF LP^ +2 => MUTLN.G
@END
@TITLE FTN08.22(1,11)
@COL 1S-3T-4T-5R-20T-6R-8R-7T-21T-23R-9R-10T-18F
@COL 12R-22R-13T-14R-15R
@ROW 8-12
@FLOW 1-10Y-3N-4N-5-20N-6-8-7N-21N-23-9-10N-18
@FLOW 3Y-12-18
@FLOW 4Y-20Y-7Y-13N-14-15-9
@FLOW 13Y-15
@FLOW 21Y-22-9
@BOX 1.0
PROC DO LABEL(LABEL)
@BOX 3.0
CURRENT LEVEL OF NESTING NOT A DO?
@BOX 4.0
LABEL USED MORE THAN ONCE
AS A DO LABEL
OR AN INTERNAL LABEL USED FOR IMPLIED
DO IN A READ/WRITE STATEMENT?
@BOX 5.0
CHECK STAT REFN:8.20:
@BOX 6.0
PLANT INCREMENT DO VAR:11.23:
@BOX 7.0
FORTRAN 66 LOOP?
@BOX 23.0
PLANT JUMP TO LOOP
DEFINE END LABEL FOR LOOP
@BOX 9.0
DECREMENT NESTING LEVEL
POP DO TABLE ENTRY
@BOX 10.0
DO LOOP HAS SPECIFIED
TERMINATOR LABEL
@BOX 12.0
FAULT
@BOX 13.0
SIGN NOT USED?
@BOX 14.0
MULT BY SIGN
@BOX 15.0
PLANT COMPARE
@BOX 8.0
SAVE ACC IF NECESSARY
PLANT STORE DO VAR:11.23:
@BOX 18.0
END
@BOX 20.0
UN-MARK DO VAR IN PROP TABLE
INCREMENT NOT NEEDED?
@BOX 21.0
TL.REPEAT NEEDED?
@BOX 22.0
TL.REPEAT
@BOX 1.1
;PROC DO.LABEL(LAB)
;$IN P,F,T,ST
;ADDR LOCAL.PROP DO.LP
;DATAVEC CONTROL($LO8)
%4D %4B
END
;0=>F
@BOX 3.1
;IF NEST.TBL[CUR.NEST.LEV.G] +NEST.TBL[CUR.NEST.LEV.G+1]  /= 0
@BOX 4.1
;IF F /= 0 OR LAB > 99999
@BOX 5.1
;PROCESS.STAT.REF(2=>F,LAB)
@BOX 6.1
;SET.A.TYPE(L.TYPE OF DO.LP^,L.LEN OF DO.LP^)
;PL.VAR.OP(%22,DO.LP)
;TL.PL(%28,INC OF DO.T[P])
@BOX 7.1
; IF T < 0
@BOX 8.1
;IF T < 0 OR ST /= 0 THEN
   ;TL.REG(2)
;FI
;PL.VAR.OP(%20,DO.LP)
@BOX 9.1
;3 -> CUR.NEST.LEV.G
;P => DO.PTR.G
@BOX 10.1
;IF LAB /= 0 AND DO.LAB OF DO.T[DO.PTR.G-1] = LAB
@BOX 18.1
;END
@BOX 12.1
;FAULT(54,1)
@BOX 13.1
;IF SIGN OF DO.T[P] => T = < 0
@BOX 14.1
;TL.PL(%2B,T)
@BOX 15.1
;TL.PL(%2F,TERM OF DO.T[P])
;TL.PL(CONTROL[SIGN OF DO.T[P] + 1],ST)
@BOX 20.1
;CV OF DO.T[DO.PTR.G-1=>P] => DO.LP
;LOOP.ST OF DO.T[P] => ST
;%FBFF &> L.SPECS OF DO.LP^
;IF LOOP.END OF DO.T[P] => T = 0
@BOX 21.1
; IF ST = 0
@BOX 22.1
; TL.REPEAT()
@BOX 23.1
;TL.PL(%4F,ST)
;TL.LABEL(LOOP.END OF DO.T[P])
@END
@TITLE FTN08.23(1,6)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
CR LABEL NAME(LABEL)
@BOX 2.0
RECREATE LABEL NAME
@BOX 3.0
END
@BOX 1.1
;PROC CR.LABEL.NAME(L)
;$IN I,M
@BOX 2.1
;-1 => I; 10000 => M
;WHILE 1 +> I < 5 DO
    ;L/M + '0 => L.N.G[I] - '0 * M -> L
    ;M/10 => M
;OD
@BOX 3.1
;END
@END

