@X @~
~L3 COUK1247
80
~V7 56 2 -5
~D10
~H                    MUSS
~
~
~D10
~H             FTN101
~D10
~MMANCHESTER UNIVERSITY  -  CONFIDENTIAL~
~
~
                                                            ISSUE 10~
~V9 -1
~P
~V9 1
~YFTN101
~S1~M~OFORTRAN 77 COMPILER IMPLEMENTATION DESCRIPTION
~S1~M~OSection 10
~S1~OSection 10. Program Unit Statements
~S1~O1.1 General Description
~BThis section performs the semantics for the Fortran statements
PROGRAM, SUBROUTINE, FUNCTION and BLOCK DATA. The semantics for
ENTRY, which is also a specification statement referring to
program units, are also done in this section.
~BMuch of the processing for SUBROUTINE and FUNCTION will be done
later in section 6, because the type of the dummy arguments and
of the result cannot be known until all the declarative statements
have been processed. This is not a problem for PROGRAM and
BLOCK DATA which do not have arguments.
~BFortran Subroutines and Functions are translated into MUTL static
procedures. When there are forward references in a program to a
Subroutine or Function, its specification is declared from the first
reference and a MUTL specification given at that point. Otherwise
the MUTL specification is declared at the end of the specification
part of the subroutine or function body, it can not be declared
sooner as the type of function may be specified within the
specification part. For similar reasons processing of dummy arguments
has to be delayed until the end of the specification part.
~BAt the beginning of a compilation 128 MUTL names are allocated
for procedures. On encountering a forward reference to a procedure
one of these pre-allocated names is used.
~BA forward linked list DUMMY.ARG.LIST of all non-label dummy arguments
is maintained. Also a backward linked list ENTRY.LIST of the local
property entries associated with entry points (FUNCTION,SUBROUTINE,ENTRY),
this is required to determine the relationships between the dummy
argument lists of multiple entry points and for checks performed
on the *END directive.
~BAlternate returns are implemented by subroutines always having an
integer result, and on return using the value to switch via a vector of labels t
o the alternate
return point.
~BBlock Data and the main program units are translated into a MUTL block.
~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 6 : (Specification Part Declrations)~
   Section 12: (property List Argument)~
   Section 13: (Fault Monitoring)~
~S1~O2.2 Section Interfaces
~
Exported Scalars:~
   PU.G~
   L.CUR.PU~
   G.CUR.PU~
   CUR.ARG.SPEC.G~
   ENTRY.LIST.TAIL.G~
   U.N.B.D.G~
~
Exported Procedures:~
   PROGRAM~
   SUBORFN~
   BLOCK.DATA~
   ENTRY~
~S1~O3. Implementation~
~S1~O3.1 Outline of Operation
~S1~O3.1.1 PROGRAM()
~BThis performs the semantics for the optional PROGRAM statement. The routine
only checks the uniqueness of the global program name, and enters
its properties in the property table.
~S1~O3.1.2 SUBORFN()
~BThis performs the semantics for the SUBROUTINE and FUNCTION
statements. The name of the subprogram is checked for uniqueness.
~BAn argument specification vector is created even if one has
already been created due to forward references. Only information
regarding the result and label dummy arguments is inserted in the
vector at this point. Information about the other dummy arguments
is added on processing the END statement. The function/subroutine
specification is checked against the implicit specification obtained
from any previous forward references on processing the END statement.
~BIn addition the program unit variables, the DUMMY.ARG.LIST and
ENTRY.LIST are initialised.
~S1~O3.1.3 BLOCK DATA()
~BThis performs the semantics for the BLOCK DATA statement.
This routine checks the uniqueness of any BLOCK DATA name present and
initalises the program unit.
~S1~O3.1.4 ENTRY()
~BThis performs the semantics for the ENTRY statement. This routine
checks the uniqueness of the ENTRY name,
creates an argument specification vector, processes the dummy arguments,
declares a MUTL entry specification and links the local property entry
to the ENTRY.LIST.
~BProcessing of the argument specification vector is similar to that
for subroutines and functions.
~BA DUMMY.ARG.LIST is created containing all non-label dummy arguments
of this entry point.
This list is passed to PROCESS.DUMMY.ARGUMENTS which declare variables
for any adjustable dimensions.
~BMultiple entries are processed in the following manner. For
each multiple entry point an alternative entry point (S) to the
enclosing program unit (PU) is defined (by calling TL.ENTRY),
note this has an identical parameter specification to the enclosing
program unit. A separate procedure (E) is then defined for an entry
point, and for any new arguments of E, i.e. those that do not appear
in an argument list of a previous entry point, an access variable is
declared. The action of E is to copy all dummy arguments, which have
access variables, to their associated variables, make a call on S
passing in the correct order all arguments then appear both in this
entry point argument list and in the Subroutine/Function argument list,
and then load the appropriate result before exiting.
~S1~O3.2 Data Structures~
~S1~OPU.G~
~BIndicates kind of current program unit~
~3
~
~M0  -  Main program unit~
~N1  -  Block data~
~N2  -  Subroutine~
~N3  -  Function~
~N4  -  Unknown~
~N5  -  Start of compilation~
~0
~S1~OL.CUR.PU~
~BPointer to the local property entry for the encoding Subroutine or
Function.~
~S1~OG.CUR.PU~
~BPointer to the global property entry for the enclosing Subroutine or
Function.~
~S1~OCUR.ARG.SPEC.G~
~BPointer to the argument specification vector for the enclosing
Subroutine or Function.~
~S1~OENTRY.LIST.TAIL.G~
~BA backward linked chain called the ENTRY.LIST of the local property
entries associated with ENTRY points is maintained. This points to
last entry added to the chain.~
~S1~OU.N.B.D.G~
~BThis is a flag, set if the program has an un-named block data unit.~
~Y
~V9 -1
~P
~D15
~HFLOWCHARTS
~
~
~H                FTN101
~V9 -1
~F
@TITLE FTN10(1,11)
@COL 1S-2R-5R-7R-9F
@FLOW 1-2-5-7-9
@BOX 1.0

23-MAR-83 (BCT) Bug fixes for validation suite+ANSYS
15-MAR-83 (BCT) Code freeze, first release at CV
28-MAR-83 (BCT) Tape sent to Manchester
28-DEC-82 (BCT) First release
PROGRAM UNITS
SECTION
@BOX 2.0
[IMPORTS FTN10/1]
MODULE HEADING
@BOX 5.0
SCALAR DECLARATIONS
@BOX 7.0
PROCEDURES IN MODULE
   PROGRAM :10.1:
   SUBROUTINE/FUNCTION :10.2:
   BLOCK DATA :10.3:
   ENTRY :10.4:
@BOX 9.0
END
@BOX 2.1
#FTN10/1
;MODULE(ENTRY.LIST.TAIL.G,L.CUR.PU,G.CUR.PU,
        PU.G,U.N.B.D.G,CUR.ARG.SPEC.G,PROGRAM,
        SUBORFN,BLOCK.DATA,ENTRY,
        ENTRY.LIST.ROOT); :: @@@ BCT 28-DEC-82
@BOX 5.1
; *GLOBAL 2
;ADDR LOCAL.PROP ENTRY.LIST.TAIL.G
;ADDR LOCAL.PROP L.CUR.PU
;ADDR GLOBAL.PROP G.CUR.PU
;$LO8 PU.G,U.N.B.D.G
;ADDR[$LO8] CUR.ARG.SPEC.G
;ADDR ENTRY.LIST ENTRY.LIST.ROOT :: @@@ BCT 28-DEC-82
; *GLOBAL 0
@BOX 7.1
;P.SPEC PROGRAM()
;P.SPEC SUBORFN()
;P.SPEC BLOCK.DATA()
;P.SPEC ENTRY()
#FTN10.1
#FTN10.2
#FTN10.3
#FTN10.4
@BOX 9.1
;*END
@END
@TITLE FTN10/1(1,11)
@COL 1S-2R-3R-4R-5R-6R-7F
@FLOW 1-2-3-4-5-6-7
@BOX 1.0
PROGRAM UNIT 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, CONST.PROP
;TYPE PROPS;
;TYPE NAME.T IS $AD[$LO8] NAME :: ??? JM 27-DEC-82
;TYPE GLOBAL.PROP IS
       ADDR GLOBAL.PROP G.NEXT.P
       NAME.T G.NAME
       $LO8 G.KIND
       $LO16 G.TL.NAME
       ADDR [$LO8] G.ARG.SPEC.P
;TYPE LOCAL.PROP;
;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 ENTRY.LIST IS
      $IN STAT.AP.ENTRY
      ADDR [$IN] ARP
      ADDR [PROPS] E.PROPS
      ADDR ENTRY.LIST NEXT :: @@@ BCT 28-DEC-82
@BOX 3.1
;IMPORT LITERAL AS.Z.L,PROPS.Z.L,GLOBAL.SPACE,SU.SIZE.L,I.ACC.TL,
    D.ARG.TYPE.L,D.ARG.SIZE.L,LOCAL.SPACE, ACC.Z.Z.L
@BOX 4.1
;$IN STAT.AP.G, CUR.NEST.LEV.G, MPU.PRESENT.G,PU.LOCALS.MUTL.NG
;ADDR LOCAL.PROP F.L.PROP.G,LOCAL.LIST.HD.G
;ADDR GLOBAL.PROP F.G.PROP.G
;$IN MUTLN.G,PU.START.MUTLN.G
;$IN CUR.A.TYPE.G, DONE.DECLARATIONS,END.AP.G :: @@@ BCT 28-DEC-82
;ADDR [PROPS] PROPS.T.DUMP.G :: @@@ BCT 28-DEC-82
;$LO16  TL.ZERO.G
@BOX 5.1
;$IN[AS.Z.L] AS
;$LO8[ACC.Z.Z.L] ACC.Z.G
;PROPS[PROPS.Z.L] PROPS.T
@BOX 6.1
;P.SPEC FAULT($IN,$IN)
;P.SPEC GET.LENGTH($IN,$IN)/$IN
;P.SPEC ADD.L.NAME(ADDR NAME.T)/ADDR LOCAL.PROP
;P.SPEC SET.A.TYPE($IN,$IN)
;P.SPEC V.DECL($IN, $IN, $IN)/$IN
;P.SPEC INIT.PU()
;P.SPEC INIT.MPU()
;P.SPEC DECLARE.PROC.SPEC(ADDR[$LO8],$IN,ADDR[$LO8])/$IN
;P.SPEC PROCESS.DUMMY.ARGUMENTS(ADDR LOCAL.PROP)
;P.SPEC MAKE.LO8($IN,$IN)/ADDR [$LO8]
;P.SPEC MAKE.LOCAL.PROP($IN)/ADDR LOCAL.PROP
;P.SPEC GET.AREA($IN,$IN)/$IN
;P.SPEC MAKE.ENTRY.LIST($IN)/ADDR ENTRY.LIST :: @@@ BCT 28-DEC-82
;P.SPEC SAVE.PROPS()/ADDR[PROPS] :: @@@ BCT 28-DEC-82
;P.SPEC MAKE.IN($IN,$IN)/ADDR[$IN] :: @@@ BCT 28-DEC-82
;L.SPEC TL.BLOCK()
;L.SPEC TL.ENTRY($IN)
;L.SPEC TL.LABEL.SPEC(ADDR[$LO8],$IN)
;L.SPEC TL.LABEL($IN)
;L.SPEC TL.PL($IN,$IN)
;L.SPEC TL.S.DECL(ADDR[$LO8],$IN,ADDR)
;L.SPEC TL.PROC($IN)
;L.SPEC TL.END.PROC()
;L.SPEC TL.C.NULL($IN)
;L.SPEC TL.PROC.SPEC(ADDR[$LO8],$IN)
@END
@TITLE FTN10.1(1,10)
@COL 2S-8R-3T-4R-5F
@COL 6R
@ROW 4-6
@FLOW 2-8-3N-4-5
@FLOW 3Y-6-5
@BOX 2.0
PROGRAM
@BOX 3.0
CHECK GLOBAL NAME
UNIQUE?
@BOX 4.0
WARNING
'NAME @ IS
NOT UNIQUE'
@BOX 5.0
END
@BOX 6.0
INIT GLOBAL PROPS
ADD TO LOCAL PROP TABLE:12.3:
INIT LOCAL PROPS
@BOX 8.0
INIT.MPU:2.5:
"PROGRAM CONTAINS MORE THAN
ONE MAIN PROGRAM
@BOX 2.1
;PROC PROGRAM
;ADDR GLOBAL.PROP GP
;ADDR LOCAL.PROP LP
@BOX 3.1
;GLOB OF PROPS.T[AS[STAT.AP.G]] => GP
;IF G.KIND OF G.P^ = 0
@BOX 4.1
;GP => F.G.PROP.G
;FAULT(%118,4)
@BOX 6.1
;9 => G.KIND OF GP^
;ADD.L.NAME(^G.NAME OF G.P^) => LP
; %800 ! > L.SPECS OF LP^
@BOX 5.1
END
@BOX 8.1
;INIT.MPU()
@END

@TITLE FTN10.2(1,11)
@COL 1S-16R-2T-13T-3R-17T-20R-4R-6T-7T-8R-9R-15R-21T-10F
@COL 11R-14R-18R-19R-12R-22R
@ROW 21-22
@ROW 3-11
@ROW 8-12
@FLOW 1-16-2N-13N-3-17N-20-4-6N-7N-8-6Y-9-15-21N-10
@FLOW 2Y-11-3
@FLOW 7Y-12-6
@FLOW 17Y-18-19-20
@FLOW 13Y-14-3
@FLOW 21Y-22-10
@BOX 1.0
SUBROUTINE OF FUNCTION
@BOX 2.0
NOTE WHETHER SUBR OR FN
SUBR OR FN PREVIOUSLY DEFINED
@BOX 3.0
INIT GLOBAL PROPS
@BOX 4.0
COUNT NO OF DUMMY ARGUMENTS
CREATE ARG SPEC ENTRY
SAVE PTR TO IT IN LOCAL PROPS
INIT RESULT BYTE FOR SUBR RESULT
(RESULT FOR FN SET LATER)
@BOX 6.0
GET NEXT DUMMY ARGUMENT
NO MORE?
@BOX 7.0
DUMMY ARG A *?
@BOX 8.0
SET DUMMY ARG BYTE IN SPEC TO ZERO
@BOX 16.0
INIT PROGRAM UNIT:2.3:
@BOX 9.0
PUT TERMINATOR BYTE IN ARG SPEC
@BOX 15.0
INIT DUMMY ARG LIST HD
INIT ENTRY LIST HD
RESET LOCAL LIST HD
SET DUMMY ARG PROP BIT
IN ALL NON LABEL DUMMY ARGUMENTS
@BOX 10.0
END
@BOX 11.0
FAULT
"NAME % IS NOT UNIQUE"
@BOX 12.0
SET DUMMY ARG SPEC
@BOX 13.0
INCONSISTANT REFNS TO
THIS SUBR/FN?
@BOX 14.0
FAULT
"EARLIER REFERENCE TO
  % IS INCONSISTANT"
@BOX 17.0
MAKE LOCAL PROPS:12.2:
NAME NOT UNIQUE
@BOX 18.0
FAULT 'NAME IS NOT
UNIQUE'
@BOX 19.0
ALLOCATE ADDITIONAL PROP
ENTRY
@BOX 20.0
INIT LOCAL PROPS
SAVE PTRS TO LOCAL
AND GLOBAL PROPS
@BOX 21.0
ALL DUMMY ARGUMENTS NOT UNIQUE
@BOX 22.0
FAULT ' ALL DUMMY ARGUMENTS
NOT UNIQUE'
@BOX 1.1
;PROC SUB.OR.FN
;ADDR LOCAL.PROP LP, LP1
;ADDR GLOBAL.PROP GP
;ADDR [$LO8] SP
;$IN AP,CNT,GK,K,LK,LS,LEN,LT,I,D,T
;LITERAL/ADDR LOCAL.PROP NIL.LP=
@BOX 16.1
;INIT.PU()
@BOX 2.1
;IF AS[STAT.AP.G => AP] => LT < 6 THEN
  ;1+>AP
;FI
;GLOB OF PROPS.T[AS[AP+1]] => GP => F.G.PROP.G
     => G.CUR.PU :: ??? JM 19-JAN-83
;IF LT = 7 THEN
    ;4 => K; 2 => PU.G; 5 => LK
;ELSE
    ;3 => K => PU.G; 6 => LK
;FI
;IF G.KIND OF G.P^ => G.K & 8 /= 0
@BOX 13.1
;IF G.K /= 0 /= 7 /= K
@BOX 3.1
;K ! 8 => G.KIND OF G.P^
@BOX 17.1
;NIL.LP => LOCAL.LIST.HD.G
;ADD.L.NAME(^G.NAME OF GP^) => LP => L.CUR.PU
;IF LOCAL.LIST.HD.G = NIL.LP
@BOX 20.1
;%800 => L.S
;IF LT /= 6 /= 7 THEN
    ;%880 => LS
;FI
;LS => L.SPECS OF LP^
;IF LT = 5 THEN
    ;GET.LENGTH(AP,1) => L.LEN OF LP^
;ELSE IF LT /= 6 THEN
       ;IF AS[AP] => LEN < 0 THEN
           ;ACC.Z.G[LT] => LEN
       ;FI
       ;IF LT = 0 AND LEN = 3 THEN
          ;1 => LT
       ;FI
       ;LEN => L.LEN OF LP^
;FI FI
;L.T => L.TYPE OF LP^
;LK => L.KIND OF LP^
@BOX 4.1
;-1 => I
;WHILE AS[1+>I+AP+2] /= -1 DO OD
;MAKE.LO8(I*2+3,GLOBAL.SPACE) => SP => CUR.ARG.SPEC.G =>L.ARG.SPEC.P OF LALT OF
LP^
;7 => SP^[0]
;1 => SP^[1]
;0=>I=>CNT
@BOX 6.1
;IF AS[1+>I+AP+1] => D = -1
@BOX 7.1
;IF D = 0
@BOX 8.1
;1  +> CNT
;0 => SP^[I+I]
@BOX 9.1
;%FF => SP^[I+I]
@BOX 10.1
;END
@BOX 11.1
;FAULT(24,4)
@BOX 14.1
;FAULT(25,4)
@BOX 12.1
;6 => SP^[I+I]
@BOX 15.1
;AP+1=>I
;WHILE AS[1+>I] = 0 DO OD
;IF AS[I] => T /= -1 THEN
   ;LOC OF PROPS.T[T] => LP1
;ELSE
   ;NIL.LP => LP1
;FI
;LP1 => L.LINK.1 OF LP^
;NIL.LP => L.LINK.2 OF LP^
        => LOCAL.LIST.HD.G
;LP => ENTRY.LIST.TAIL.G
;WHILE LP1 /= NIL.LP DO
     ;1->CNT
  ;%200 =>L.SPECS OF LP1^
;NIL.LP => L.LINK2 OF LP1^
  ;L.LINK1 OF LP1^ => LP1
;OD
@BOX 18.1
;FAULT(24,4)
@BOX 19.1
;MAKE.LOCAL.PROP(LOCAL.SPACE) => LP
;L.CUR.PU => LP1
;LP1^ => LP^
;LP => L.CUR.PU
@BOX 21.1
;IF CNT /= 0
@BOX 22.1
;FAULT(142,6)
@END
@TITLE FTN10.3(1,6)
@COL 13T-14R-15R
@COL 2S-6T-10T-11R-3R-4R-5F
@COL 12R
@ROW 13-10
@ROW 11-12
@FLOW 2-6N-10N-11-3-4-5
@FLOW 10Y-12-3
@FLOW 6Y-13N-14-15-4
@FLOW 13Y-15
@BOX 2.0
BLOCK DATA
@BOX 10.0
CHECK GLOBAL NAME
UNIQUE?
@BOX 11.0
WARNING 27
'BLOCK DATA NAME %
IS NOT UNIQUE'
@BOX 12.0
ADD PROPS TO TABLE
@BOX 3.0
MAKE LOCAL PROP
@BOX 4.0
SET PU KIND TO BLOCK DATA
INIT PU:2.3:
@BOX 6.0
BLOCK DATA NAME NOT SPECIFIED?
@BOX 5.0
END
@BOX 13.0
FIRST UNNAMED BLOCK DATA?
@BOX 14.0
WARNING 27
@BOX 15.0
NOTE UNNAMED
@BOX 2.1
;PROC BLOCK.DATA
;LITERAL/ADDR GLOBAL.PROP G.NIL =
;ADDR LOCAL.PROP LP
;ADDR GLOBAL.PROP GP
;$IN P
@BOX 6.1
;IF AS[STAT.AP.G] => P = 0
@BOX 10.1
;GLOB OF PROPS.T[P] => GP
;IF G.KIND OF GP^ = 0
@BOX 11.1
;GP => F.G.PROP.G
;FAULT(%118,4)
@BOX 12.1
;10 => G.KIND OF G.P^
@BOX 3.1
;ADD.L.NAME(^G.NAME OF G.P^) => L.P
;%800 => L.SPECS OF L.P^
@BOX 4.1
;INIT.PU()
;1=>PU.G
@BOX 5.1
END
@BOX 13.1
;IF U.N.B.D.G = 0
@BOX 14.1
;FAULT(%118,6)
@BOX 15.1
;1 => U.N.B.D.G
@END
@TITLE FTN10.4(1,11)
@COL 1S-2T-3T-4T-22T-5T-6T-7T-8R-19R-9R-10R-11R-20R-21R-12F
@COL 13R-14R-15R-16R-17T-18R-23R
@ROW 2-13
@ROW 7-17
@FLOW 1-2N-3N-4N-22N-5N-6N-7N-8-19-9-10-11-20-21-12
@FLOW 2Y-13-3Y-14-5
@FLOW 4Y-15-5Y-16-6Y-17N-18-8
@FLOW 17Y-8
@FLOW 7Y-18
@FLOW 22Y-23-12
@BOX 1.0
ENTRY
@BOX 2.0
IN A BLOCK IF OR
A DO OR MAIN PU
@BOX 3.0
GLOBAL NAME ALREADY DEFINED?
@BOX 4.0
ENTRY NAME USED INCONSISTENTLY?
@BOX 5.0
GET LOCAL ENTRY:12.2:
IS ENTRY NAME A DUMMY ARGUMENT,
OR IN EXTERNAL, INTRINSIC, EQUIVALENCE,
PARAMETER,COMMON,SAVE ?
@BOX 6.0
IN A SUBROUTINE?
@BOX 7.0
ENTRY NAME OF TYPE CHAR
AND FN NOT OF IDENTICAL TYPE
@BOX 8.0
INIT GLOBAL PROPS
INIT LOCAL PROPS
@BOX 9.0
DECLARE ENTRY:10.4.1:
@BOX 10.0
LINK TO ENTRY LIST
RESET LOCAL LIST
@BOX 11.0
PROCESS DUMMY ARGUMENT LIST:6.3:
@BOX 12.0
END
@BOX 13.0
FAULT
"STATEMENT NOT ALLOWED IN
A BLOCK IF OR DO"
@BOX 14.0
FAULT
"NAME @ IS NOT UNIQUE"
@BOX 15.0
FAULT
"EARLIER REFERENCE TO @
IS INCONSISTANT"
@BOX 16.0
FAULT
"NAME @ IS NOT UNIQUE"
@BOX 17.0
ENTRY NAME NOT TYPED?
@BOX 18.0
FAULT
"@ MUST NOT BE TYPED"
@BOX 19.0
PLANT JUMP AROUND ENTRY CODE
@BOX 20.0
DEFINE PROCEDURE FOR ENTRY POINT
@BOX 21.0
DEFINE END OF
ENTRY POINT CODE LABEL
@BOX 22.0
WITHIN DECLARATIONS?
@BOX 23.0
SAVE THE ENTRY TILL LATER
@BOX 1.1
;PROC ENTRY
;ADDR GLOBAL.PROP GP
;ADDR LOCAL.PROP LP,LP1,DLP,ELP,LP2,M.D.LP
;$IN AP,LT,GK,LS,I,T,N,II
;$IN LAB
;$IN[256] MN
;LITERAL/ADDR LOCAL.PROP NIL.LP=
;ADDR [$LO8] SP,PREV.SP
;LITERAL/ADDR[$LO8] NIL.STR=
;ADDR ENTRY.LIST NODE :: @@@ BCT 28-DEC-82
;ADDR [$IN] AS.DUMP :: @@@ BCT 28-DEC-82
;LITERAL/ADDR [PROPS] NIL.PROPS =  :: @@@ BCT 28-DEC-82
@BOX 2.1
;IF CUR.NEST.LEV.G /= 0 OR PU.G = 0
@BOX 3.1
;GLOB OF PROPS.T[AS[STAT.AP.G=>AP]] => G.P => F.G.PROP.G
;IF G.KIND OF G.P^ => G.K & 8 /= 0
@BOX 4.1
;IF GK /= 0 AND GK /= 7 AND [GK/=3 OR PUG/=3]
     AND [GK/=4 OR PUG /= 2]
@BOX 5.1
;ADD.L.NAME(^G.NAME OF GP^) => LP
;IF L.SPECS OF LP^ => LS & %E7F ! L.KIND OF LP^ /= 0
@BOX 6.1
;L.TYPE OF LP^ => LT
;IF PUG = 2
@BOX 7.1
;IF LT = 5 AND [L.TYPE OF L.CUR.PU^ /= 5
    OR L.LEN OF LP^ /= L.LEN OF L.CUR.PU^
    AND [L.LEN OF LP^ >= 0 OR L.LEN OF L.CUR.PU^ >= 0]]
@BOX 8.1
;6 - PUG ! 8  => G.KIND OF GP^
;%800 !> L.SPECS OF LP^
@BOX 9.1
#FTN10.4.1
@BOX 10.1
;LP => L.LINK2 OF ENTRY.LIST.TAIL.G^
;LP => ENTRY.LIST.TAIL.G
;NIL.LP => L.LINK2 OF LP^ => LOCAL.LIST.HD.G
@BOX 11.1
;PROCESS.DUMMY.ARGUMENTS(L.LINK1 OF LP^)
@BOX 12.1
;END
@BOX 13.1
;FAULT(28,4)
@BOX 14.1
;FAULT(24,4)
@BOX 15.1
;FAULT(25,4)
@BOX 16.1
;FAULT(24,4)
@BOX 17.1
;IF LS & %80 = 0
@BOX 18.1
;FAULT(26,4)
@BOX 19.1
;TL.LABEL.SPEC(NIL.STR,0)
;TL.PL(%4F,MUTL.NG => LAB)
;1 +> MUTL.NG
@BOX 20.1
#FTN10.4.2
@BOX 21.1
;TL.LABEL(LAB)
@BOX 22.1
:: @@@ BCT 28-DEC-82 Start of new code
;IF DONE.DECLARATIONS = 0
@BOX 23.1
;MAKE.ENTRY.LIST(LOCAL.SPACE) => NODE
;ENTRY.LIST.ROOT => NEXT OF NODE^
;NODE => ENTRY.LIST.ROOT
;SELECT NODE^
;MAKE.IN(END.AP.G+1,LOCAL.SPACE) => AS.DUMP => ARP
;FOR I < END.AP.G+1 DO
    AS[I] => AS.DUMP^[I] OD
;NIL.PROPS => PROPS.T.DUMP.G
;SAVE.PROPS() => E.PROPS
;STAT.AP.G => STAT.AP.ENTRY
:: @@@ BCT 28-DEC-82 end of new code
@END
@TITLE FTN10.4.1(1,11)
@COL 1S-5R-7T-8T-9R-10T-11T-12R-14R-4R-2R-16R-17F
@COL 21R-22T-23R-20R-13R
@ROW 9-21
@FLOW 1-5-7N-8N-9-10N-11N-12-14-7
@FLOW 7Y-4-2-16-17
@FLOW 8Y-21-22N-23-7
@FLOW 22Y-7
@FLOW 10Y-20-14
@FLOW 11Y-13-14
@BOX 1.0
DECLARE ENTRY
@BOX 2.0
DECLARE MUTL PSPEC WITH
SPECIFICATION IDENTICAL TO THAT
OF ENCLOSING PROGRAM UNIT
@BOX 4.0
SET TERMINAL BYTE
SET RESULT BYTE IN ARG SPEC
@BOX 5.0
COUNT NO OF DUMMY ARGUMENTS
CREATE ARG SPEC ENTRY
SAVE PTR TO IT IN LOCAL PROPS
INIT DUMMY ARG LIST
@BOX 7.0
GET NEXT DUMMY ARG
NO MORE?
@BOX 8.0
DUMMY ARG = *?
@BOX 9.0
SET ARG SPEC BYTE
@BOX 10.0
ARG APPEARS IN A PREVIOUS DUMMY ARG LIST?
@BOX 11.0
ARG NOT REFN,NOR IN A
EQUIVALENCE,SAVE,INTRINSIC,COMMON,PARAMETER STAT?
@BOX 12.0
FAULT
"NAME @ IS NOT UNIQUE"
@BOX 13.0
ALLOCATE STATIC VAR FOR
COPY OF DUMMY ARGUMENT
@BOX 14.0
LINK TO DUMMY ARG LIST
MARK AS DUMMY ARG
@BOX 16.0
DECLARE MULTIPLE ENTRY
POINT TO MUTL
ALLOCATE RESULT VARIABLE IF NECESSARY
@BOX 17.0
END
@BOX 20.0
ALLOCATE EXTRA PROPERTY ENTRY
AND COPY IT
@BOX 21.0
SET ARG BYTE IN SPEC
@BOX 22.0
SUBROUTINE
@BOX 23.0
FAULT
"* NOT ALLOWED ON A FUNCTION"
@BOX 1.1
@BOX 5.1
;-1 => I
;WHILE AS[1+>I+AP+1] /= -1 DO OD
;MAKE.LO8(I*2+3,GLOBAL.SPACE) => SP
     => L.ARG.SPEC.P OF L.ALT OF LP^
;NIL.LP => L.LINK1 OF LP^
;LP => LP1
;0 => I => II
@BOX 7.1
;2 +> II
;IF AS[1+>I+AP] => T = -1
@BOX 8.1
;IF T = 0
@BOX 9.1
;LOC OF PROPS.T[T] => DLP
;L.TYPE OF D.LP^ ! 8 => SP^[II]
@BOX 10.1
;IF L.SPECS OF D.LP^ & %200 /= 0
@BOX 11.1
; NIL.LP => L.LINK2 OF DLP^
;IF L.SPECS OF D.LP^ & %C5D ! L.TL.NAME OF D.LP^ = 0
@BOX 12.1
;D.LP => F.L.PROP.G
;FAULT(24,1)
@BOX 13.1
;GET.AREA(0,D.ARG.SIZE.L)
;TL.S.DECL(NAME OF L.NAME OF DL.P^,D.ARG.TYPE.L,0) :: ??? JM 27-DEC-82
;MUTL.NG => L.TL.NAME OF DL.P^ + 1 => MUTL.NG
;IF L.TYPE OF D.LP^ = 5 AND
      L.LEN OF DL.P^ < 0 THEN
      ;0 -V.DECL(%103,1,0) => L.LEN OF D.LP^
;FI
@BOX 14.1
;D.LP => L.LINK1 OF LP1^
;NIL.LP => L.LINK1 OF DLP^
;D.LP => LP1
;%200 !> L.SPECS OF D.LP^
@BOX 21.1
;6 => SP^[II]
;0 => SP^[II+1]
@BOX 22.1
;IF PUG = 2
@BOX 23.1
;FAULT(31,1)
@BOX 2.1
;DECLARE.PROC.SPEC(CUR.ARG.SPEC.G,0,NIL.STR)
   => L.SPEC.TL.NAME OF L.ALT OF LP^
@BOX 20.1
;MAKE.LOCAL.PROP(LOCAL.SPACE) => LP2
;D.LP^ => LP2^
;D.LP => L.LINK2 OF LP2^
;LP2 => D.LP
@BOX 4.1
;%FF=>SP^[II]
;IF PUG = 2 THEN
   ;7 => SP^[0]
   ;1 => SP^[1]
;ELSE
   ;LT => SP^[0]
   ;IF LT = 5 THEN
     0 => SP^[1]
    ELSE
     L.LEN OF LP^ => SP^[1]
    FI
;FI
@BOX 16.1
;IF PUG = 3 THEN
   ;IF LT /= 5 THEN
      ;IF LT = 1 OR LT=2 THEN
         ;2=>T
      ;ELSE
         ;1 => T
      ;FI
      ;V.DECL(%100!LT,L.LEN OF LP^,0) =>
           L.TL.NAME OF LP^
      ;1 => L.KIND OF LP^
   ;ELSE
      ;%200 !> L.SPECS OF LP^
      ;L.TL.NAME OF L.CUR.PU^ => L.TL.NAME OF LP^
      ;L.LEN OF L.CUR.PU^ => L.LEN OF LP^
   ;FI
;FI
;TL.ENTRY(L.SPEC.TL.NAME OF L.ALT OF LP^)
@BOX 17.1
::END
@END
@TITLE FTN10.4.2(1,11)
@COL 1S-15R-2R-3R-4R-5R-7T-8T-9R-10R-11R-12R-13F
@COL 6R-14R
@ROW  9-14
@ROW 5-6
@FLOW 1-15-2-3-4-5-6-7N-8N-9-10-11-12-13
@FLOW 7Y-10
@FLOW 8Y-14-11
@BOX 1.0
DEFINE ENTRY POINT PROCEDURE
@BOX 2.0
START OF PROCEDURE
@BOX 3.0
ALLOCATE NEW MUTL NAMES FOR
DUMMY ARGUMENTS OF THIS PROCEDURE
@BOX 4.0
ALLOCATE MUTLNAMES FOR
CHARACTER FN RESULT PARAMETER IF NECESSARY
@BOX 5.0
FOR ALL ARGUMENTS NOT IN MAIN ENTRY ARGUMENT LIST
PLANT CODE TO COPY ARGUMENTS TO STATIC VARIABLES
@BOX 6.0
PLANT CALL TO MAIN ENTRY POINT OF PROCEDURE
PASSING AS ARGUMENTS THOSE THAT APPEAR BOTH
IN THIS ENTRY AND THE MAIN ENTRY ARGUMENT LIST
@BOX 7.0
SUBROUTINE?
@BOX 8.0
CHAR FUNCTION?
@BOX 9.0
PLANT A = RESULT
@BOX 10.0
NOTE RESULT IS A
@BOX 11.0
PLANT RETURN
@BOX 12.0
END OF PROC
@BOX 13.0
END
@BOX 14.0
NOTE NO RESULT
@BOX 15.0
DECLARE PROC SPEC TO MUTL IF
NOT ALREADY DECLARED
@BOX 1.1
::FTN10.4.2
@BOX 15.1
;IF G.ARG.SPEC.P OF G.P^ = NIL.STR THEN
   ;IF G.TL.NAME OF G.P^ => N = 0 THEN
      ;%4001 => T
   ;ELSE
      ;N ! %5000 => T
   ;FI
   ;DECLARE.PROC.SPEC(SP,T,NAME OF G.NAME OF G.P^)
      => G.TL.NAME OF G.P^
  ELSE
   TL.PROC.SPEC(NAME OF G.NAME OF GP^,G.TL.NAME OF GP^ ! %5000)
;FI
@BOX 2.1
;TL.PROC(G.TL.NAME OF G.P^)
@BOX 3.1
;-1 => I
;MUTLNG => N
;L.P => D.LP
;WHILE L.LINK1 OF D.LP^ => D.LP /= NIL.LP DO
   ;N => M.N[1+>I]
   ;1 +> N
   ;IF L.TYPE OF D.LP^ = 5 THEN
      ;1 +> N
   ;FI
;OD
@BOX 4.1
::N IS MUTL NAME
@BOX 5.1
;LP => D.LP
;-1 => I
;WHILE L.LINK.1 OF D.LP^ => D.LP /= NIL.LP DO
   ;1 +> I
   ;IF L.TL.NAME OF D.LP^ => T >= PU.LOCALS.MUTL.NG THEN
      ;SET.A.TYPE(L.TYPE OF D.LP^ ! 8,L.LEN OF D.LP^)
      ;TL.PL(%22,MN[I])
      ;TL.PL(%20,T)
   ;FI
   ;IF L.TYPE OF D.LP^ = 5 AND L.LEN OF D.LP^ <0 THEN
      ;TL.PL(%46,%44)
      ;TL.PL(%22,MN[I]+1)
      ;TL.PL(%20,T)
      ;-1 => CUR.A.TYPE.G
   ;FI
OD
@BOX 6.1
;TL.C.NULL(D.ARG.TYPE.L)
;TL.PL(%40,L.SPEC.TL.NAME OF L.ALT OF LP^)
;L.CUR.PU => M.D.LP
;WHILE L.LINK.1 OF M.D.LP^ => M.D.LP /= NIL.LP DO
   ;0 => T
   ;-1 => I
   ;LP => D.LP
   ;WHILE L.LINK.1 OF D.LP^ => D.LP /= NIL.LP AND T = 0 DO
      ;1 +> I
      ;IF L.TL.NAME OF D.LP^ = L.TL.NAME OF M.D.LP^ THEN
         ;MN[I] => T
      ;FI
   ;OD
   ;SET.A.TYPE(L.TYPE OF M.D.LP^ => LT ! 8,L.LEN OF M.D.LP^)
   ;TL.PL(%22,T)
   ;TL.PL(%41,%3000)
   ;IF LT = 5 THEN
      ;IF L.LEN OF MD.LP^ < 0 AND T /=0 THEN
         ;1 +> T
      ;ELSE
         ;TL.ZERO.G => T
      ;FI
      ;TL.PL(%46,%44)
      ;TL.PL(%22,T)
      ;TL.PL(%41,%3000)
      ;-1 => CUR.A.TYPE.G
   ;FI
;OD
;IF L.TYPE OF L.CUR.PU^ = 5 THEN
   ;SET.A.TYPE(%D,0)
   ;TL.PL(%22,N)
   ;TL.PL(%41,%3000)
   ;TL.PL(%46,%44)
   ;TL.PL(%22,N+1)
   ;TL.PL(%41,%3000)
   ;-1 => CUR.A.TYPE.G
;FI
;TL.PL(%42,0)
@BOX 7.1
;IF PUG = 2
@BOX 8.1
;IF L.TYPE OF L.CUR.PU^ => LT = 5
@BOX 9.1
;SET.A.TYPE(LT,L.LEN OF LP^)
;TL.PL(%22,L.TL.NAME OF LP^)
@BOX 10.1
;%3000 => T
@BOX 11.1
;TL.PL(%43,T)
@BOX 12.1
;TL.END.PROC()
@BOX 13.1
::END
@BOX 14.1
;0 => T
@END



