@X @~
~V7 56 2 -5
~D10
~H                    MUSS
~
~
~D10
~H             FTN141
~D10
~MMANCHESTER UNIVERSITY  -  CONFIDENTIAL~
~
~
                                                            ISSUE 11~
~V9 -1
~P
~V9 1
~YFTN141
~S1~M~OFORTRAN 77 COMPILER IMPLEMENTATION DESCRIPTION
~S1~M~OSection 14~
~S1~OSection 14. Compiler Directives
~S1~O1.1 General Description
~BThis section performs the semantics for the Compiler directives.
These are statements (in column 7 or after) which begin with an asterisk(*).
They are not part of the Fortran 77, but direct the compiler in some way
which does not alter the meaning of the Fortran program.
~BThe *END directive optionally marks the end
of the source program.
The END.DIRECTIVE procedure is envoked if the
end of the source program input is reached before
a *END directive is encountered, as well as when the *END is encountered.
~BThe *MAP directive is used to optionally map data and code areas
into specific segments. This is particularly useful for library
management.
~BThe *IMPORT and *LIB directives are used to link the Fortran
program with previously defined libraries, and the *EXPORT directive
allows libraries to be made of Fortran subprograms.
~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 Declarations)~
   Section 10: (Program Unit Statements)~
   Section 12: (Property List Management)~
   Section 13: (Fault Monitoring)~
~Q 9
~S1~O2.2 Section Interfaces
~
Exported Procedures:~
   END.DIRECTIVE~
   MAP.DIRECTIVE~
   EXPORT.DIRECTIVE~
   IMPORT.DIRECTIVE~
   LIB.DIRECTIVE~
~
Exported Vectors~
   SEG.INFO~
   CODE.AREA.NO~
~S1~O3. Implementation
~S1~O3.1 Outline of Operation
~S1~O3.1.1 END.DIRECTIVE()
~BThis performs the semantics for the *END directive. It performs
checks to ensure that a main program unit is present, and that each
subprogram referenced has been defined.~
~BFinally the number of errors are printed and
PW0 set to zero if there are none, and non zero if
otherwise.
~S~O3.1.2 MAP.DIRECTIVE()
~BThis directive maps the specified segments with a data area
and updates tables with the appropriate information to enable
section 6 to perform the correct store allocation. The specified
code segments are selected in this procedure. A check is made
for the *MAP DATA directive to ensure it has not occurred in
a program unit.~
~S1~O3.1.3 EXPORT.DIRECTIVE()
~BThis directive allows libraries to be built of Fortran
subprograms by performing the export of specified subprograms.
~S1~O3.1.4 IMPORT.DIRECTIVE()
~BThis directive looks up the specified library procedure, and extracts
its parameter and result types, converts them to Fortran properties
and updates the global property entry.
~S1~O3.1.5 LIB.DIRECTIVE()
~BThis directive adds all the procedures of a specified library to the
global properties.~
~S1~O3.2 Data Structures
~BEXIT.PROG.LABEL.N.G is a label marking the end of a completed
Fortran program. It is planted at the *END, and jumped to from
With in STOP procedure.
~Y
~V9 -1
~P
~D15
~HFLOWCHARTS
~
~
~H                FTN141
~V9 -1
~F
@TITLE FTN14(1,11)
@COL 1S-2R-5R-6R-7R-9F
@FLOW 1-2-5-6-7-9
@BOX 1.0
COMPILER DIRECTIVES
@BOX 2.0
[IMPORTS FTN14/1]
MODULE HEADING
@BOX 5.0
SCALAR DECLARATIONS
@BOX 6.0
VECTOR DECLARATIONS
@BOX 7.0
PROCEDURES IN MODULE
   END COMPILE :14.1:
   MAP :14.2:
   EXPORT :14.3:
   IMPORT :14.4:
   LIB :14.5:
   DECLARE.LIB.PROC :14.6:
   SHORT.INT :14.8:
   MAP.COMMON :14.9:
@BOX 9.0
END
@BOX 2.1
#FTN14/1
;MODULE (END.DIRECTIVE,MAP.DIRECTIVE,SEG.INFO,CODE.AREA.NO,SHORT.INT,MAP.COMMON,
     EXPORT.DIRECTIVE,IMPORT.DIRECTIVE,LIB.DIRECTIVE,EXIT.PROG.LABEL.N.G);
@BOX 5.1
;*GLOBAL 4
; *GLOBAL 2
 ; $IN EXIT.PROG.LABEL.N.G
@BOX 6.1
; $LO8 [32] SEG.INFO
; $LO8 [32] CODE.AREA.NO
; *GLOBAL 0
@BOX 7.1
;P.SPEC END.DIRECTIVE()
;P.SPEC MAP.DIRECTIVE()
;P.SPEC EXPORT.DIRECTIVE()
;P.SPEC IMPORT.DIRECTIVE()
;P.SPEC LIB.DIRECTIVE()
;P.SPEC DECLARE.LIB.PROC(ADDR[$LO8],$IN,$LO32)
;P.SPEC SHORT.INT()
;P.SPEC MAP.COMMON()
#FTN14.1
#FTN14.2
#FTN14.3
#FTN14.4
#FTN14.5
#FTN14.6
#FTN14.8
#FTN14.9
@BOX 9.1
;*END
@END
@TITLE FTN14/1(1,11)
@COL 1S-2R-3R-4R-5R-6R-7F
@FLOW 1-2-3-4-5-6-7
@BOX 1.0
DIRECTIVE 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 NAME.T IS $AD[$LO8] NAME :: ??? JM 27-DEC-82
;TYPE LOCAL.PROP;
;TYPE PROPS;
;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
@BOX 3.1
;IMPORT LITERAL $LO32 MAX.SEG.Z.L
;IMPORT LITERAL GLOBAL.HASH.Z.L,AS.Z.L,PROPS.Z.L,
   RES.TYPE.Z.L,MUTL.ARG.TYPE.Z.L,GLOBAL.SPACE,D.ARG.TYPE.L,
   ACC.Z.Z.L :: @@@ BCT 29-DEC-82
;IMPORT LITERAL $LO8 SPACE.L
;IMPORT LITERAL $LO32 TL.LIBRARY.BIT.L
@BOX 4.1
;$LO32 INFORM.LINE.G
;$IN MPU.PRESENT.G,MUTLN.G,MON.STR
;$IN STAT.AP.G,MUTL.DA.N.G,I.ACC.Z.G,L.ACC.Z.G
; ADDR COMMON.PROP BLANK.COM.G,F.C.PROP.G
; $LO8 PU.G
; ADDR [$LO8] F.B.G
@BOX 5.1
; $LO8 [ACC.Z.Z.L] ACC.Z.G
;ADDR GLOBAL.PROP[GLOBAL.HASH.Z.L]G.HASH
; $IN [AS.Z.L] AS
; PROPS[PROPS.Z.L] PROPS.T
; ADDR [3] SEG.Z.TBL
; $IN [3] SEG.TBL
; $LO16 [3] AREA.TBL
; $LO8 [MUTL.ARG.TYPE.Z.L] MUTL.ARG.TYPES
@BOX 6.1
;P.SPEC ADD.G.NAME(ADDR NAME.T)/ADDR GLOBAL.PROP
;P.SPEC FAULT($IN,$IN)    ::FTN13.1
;P.SPEC MAKE.LO8($IN,$IN)/ADDR [$LO8]
;P.SPEC GET.SEG()/$IN
;L.SPEC LIBRARY(ADDR[$LO8],$IN)
;L.SPEC FIND.N(ADDR[$LO8],$IN)/$LO32
::CV ;P.SPEC FIND.N(ADDR[$LO8],$IN)/$LO32
;L.SPEC FIND.P($LO32,$IN,$IN)/$IN
::CV ;P.SPEC FIND.P($LO32,$IN,$IN)/$IN
;L.SPEC LOOK.UP.N($IN,ADDR[$LO8],ADDR[$LO8])/$LO32
;L.SPEC CAPTION(ADDR[$LO8])
;L.SPEC OUTI($IN32,$IN)
;L.SPEC SELECT.OUTPUT($IN)
;L.SPEC NEWLINES($IN)
;L.SPEC TL.LABEL($IN)
;L.SPEC TL.SEG($IN,ADDR,$LO32,ADDR,$IN)
;L.SPEC TL.LOAD($IN,$IN)
;L.SPEC TL.CODE.AREA($IN)
;L.SPEC TL.PROC.SPEC(ADDR[$LO8],$IN)
;L.SPEC TL.PROC.PARAM($IN,ADDR)
;L.SPEC TL.PROC.RESULT($IN)
;L.SPEC TL.COMMON(ADDR [$LO8],$IN32,$IN)
@END
@TITLE FTN14.1(1,11)
@COL 2S-4T-8R-5R-27T-12T-13T-14R-15R-6R
@COL 7R-26F
@ROW 8-7
@ROW 12-26
@FLOW 2-4NO-8-5-27NO-12YES-6-27
@FLOW 13NO-14-15-6-27YES-26
@FLOW 12NO-13YES-15
@FLOW 4YES-7-5
@BOX 2.0
END COMPILE DIRECTIVE
@BOX 7.0
DEFINE EXIT PROGRAM
RESTART LABEL
@BOX 4.0
MPU COMPILED?
@BOX 5.0
CLEAR PU ABSENT FAULT
SELECT MONITORING STREAM
@BOX 27.0
GET NEXT PU
ALL PU CHECKED?
@BOX 6.0
ADVANCE TO NEXT
PU NAME IN HASH LIST
@BOX 12.0
PU DEFINED?
@BOX 13.0
FAULT SET?
@BOX 14.0
FAULT
SET FAULT
@BOX 15.0
PRINT PU NAME
@BOX 8.0
FAULT
@BOX 26.0
END
@BOX 2.1
;PROC END.DIRECTIVE
;$IN F, I, GK,Z
;ADDR GLOBAL.PROP GP
;LITERAL/ADDR [$LO8] NIL.STR =
;LITERAL/ADDR GLOBAL.PROP NIL.GP =
@BOX 7.1
;TL.LABEL(EXIT.PROG.LABEL.N.G)
@BOX 4.1
;IF MPU.PRESENT.G /= 0
@BOX 8.1
;IF INFORM.LINE.G & TL.LIBRARY.BIT.L = 0 THEN
   ;FAULT(%175,1)
;FI
@BOX 5.1
;0 => F
;-1 => I
;NIL.GP => GP
;SELECT.OUTPUT(MON.STR)
@BOX 27.1
;WHILE GP = NIL.GP AND 1+>I < GLOBAL.HASH.Z.L DO
    ;GHASH[I] => GP
;OD
;IF I >= GLOBAL.HASH.Z.L
@BOX 12.1
;IF G.KIND OF GP^ & 8 /= 0
@BOX 13.1
;IF F /= 0
@BOX 14.1
;FAULT(118,1)
;1 => F
@BOX 15.1
;CAPTION(NAME OF G.NAME OF GP^) :: ??? JM 27-DEC-82
;NEWLINES(1)
@BOX 6.1
;G.NEXT.P OF GP^ => GP
@BOX 26.1
;END
@END
@TITLE FTN14.2(1,11)
@COL 3C-4T-5T-6R-7R-8R
@COL 1S-2T-9C-10T-11T-14R-24F
@COL 16C-17T-19T-18T-21R-15R
@COL 22R-20R-23R
@ROW 3-9-16
@ROW 19-22
@ROW 8-14-15
@FLOW 1-2
@FLOW 3-4N-5N-6-7-24
@FLOW 4Y-8-24
@FLOW 5Y-7
@FLOW 9-10N-11N-14-24
@FLOW 10Y-8
@FLOW 11Y-15-24
@FLOW 16-17N-19N-18N-21-24
@FLOW 17Y-22-24
@FLOW 18Y-23-24
@FLOW 19Y-20-24
@BOX 1.0
MAP DIRECTIVE
@BOX 2.0
SWITCH ON OPTION
@BOX 3.0
CODE
@BOX 4.0
INVALID SEG NO?
@BOX 5.0
ALREADY LOADED?
@BOX 6.0
LOAD AREA
@BOX 7.0
SELECT AREA
NOTE SEG
@BOX 8.0
FAULT
@BOX 9.0
COMMON
@BOX 10.0
INVALID SEG NO?
@BOX 11.0
PREVIOUSLY MAPPED?
@BOX 14.0
LOAD AREA
SET UP COMMON
NOTE SEG
@BOX 15.0
FAULT
@BOX 16.0
DATA
@BOX 17.0
IN P.U.?
@BOX 18.0
INVALID SEG NO?
@BOX 21.0
SET UP AREA
LOAD AREA
NOTE SEG
@BOX 22.0
FAULT
@BOX 23.0
FAULT
@BOX 24.0
END
@BOX 19.0
SEG = 0?
@BOX 20.0
RESET MAPPPING
@BOX 1.1
; PROC MAP.DIRECTIVE
; $IN AP,SEG,AREA
; ADDR COMMON.PROP CP
@BOX 2.1
; INT OF PROPS.T[AS[STAT.AP.G=>AP+2]] => SEG
; SWITCH AS[AP] \
   COMMON,BLANK,CODE,DATA
@BOX 3.1
; CODE:
@BOX 4.1
;IF SEG > 31 OR SEG < 0 OR
    SEG.INFO[SEG]  = 1
@BOX 5.1
;IF CODE.AREA.NO[SEG] => AREA /= 0
@BOX 6.1
;TL.LOAD(SEG,1+>MUTL.DA.N.G=>AREA)
@BOX 7.1
;TL.CODE.AREA(AREA=>CODE.AREA.NO[SEG])
; 2!>SEG.INFO[SEG]
@BOX 8.1
;FAULT(388,6)
@BOX 9.1
;COMMON:BLANK:
@BOX 10.1
;IF SEG > 31 OR SEG < 0 OR
   SEG.INFO[SEG]&1 /= 0
@BOX 11.1
; IF AS[AP+1]=> AREA /= 0 THEN
   COM OF PROPS.T[AREA] => CP
ELSE BLANK.COM.G =>CP FI
;IF C.AREA.NO OF CP^ /= 0
@BOX 14.1
; 2!>SEG.INFO[SEG]
;SEG => C.AREA.NO OF CP^
;IF AS[AP+3]=> AREA=0 AND CP=BLANK.COM.G THEN
   MAX.SEG.Z.L => C.SIZE OF CP^
ELSE INT OF PROPS.T[AREA]=> C.SIZE OF CP^ FI
; TL.LOAD(SEG, 1+>MUTL.DA.N.G => C.AREA.NO OF CP^)
; TL.COMMON(NAME OF C.NAME OF CP^,0,MUTL.DA.N.G!%4000)
@BOX 15.1
; CP=> F.C.PROP.G
; FAULT(389,2)
@BOX 16.1
;DATA:
@BOX 17.1
;IF PU.G < 4
@BOX 18.1
;IF SEG > 31 OR SEG < 0 OR
   SEG.INFO[SEG]= 1
@BOX 19.1
;IF SEG=0
@BOX 20.1
;0=> SEG.TBL[2]
@BOX 21.1
; 2!> SEG.INFO[SEG]
; SEG => SEG.TBL[2]
; TL.LOAD(SEG,1+>MUTL.DA.N.G)
; MUTL.DA.N.G => AREA.TBL[2]
; IF AS[AP+3]=>AREA = 0 THEN MAX.SEG.Z.L => SEG.Z.TBL[2]
   ELSE INT OF PROPS.T[AREA] => SEG.Z.TBL[2] FI
@BOX 22.1
; FAULT(391,6)
@BOX 23.1
; FAULT(388,6)
@BOX 24.1
END
@END
@TITLE FTN14.3(1,11)
@COL 1S-2T-3R-4T-5R
@COL 6R-7F
@ROW 3-6
@FLOW 1-2N-3-4N-5-4Y-7
@FLOW 2Y-6-7
@BOX 1.0
EXPORT DIRECTIVE
@BOX 2.0
NOT AT START OF PROGRAM?
@BOX 3
SELECT FIRST ARGUMENT
@BOX 4.0
NO MORE ARGUMENTS?
@BOX 5.0
DECLARE EXPORTED
PROC TO MUTL
ADD TO GLOBAL PROPS
@BOX 6.0
FAULT
@BOX 7.0
END
@BOX 1.1
;PROC EXPORT.DIRECTIVE
;$IN AP, AR, I
;ADDR [$LO8] IP
;ADDR GLOBAL.PROP GP
@BOX 2.1
;IF PU.G /= 5
@BOX 3.1
;STAT.AP.G - 1 => AP
@BOX 4.1
;IF AS[1+>AP] => AR = -1
@BOX 5.1
;GLOB OF PROPS.T[AR] => GP
;NAME OF GNAME OF GP^ => IP
;TL.PROC.SPEC(IP,%6009)
;MUTLN.G => G.TL.NAME OF GP^ + 1 => MUTLN.G
;7 => G.KIND OF GP^
@BOX 6.1
;FAULT(138,6)
@BOX 7.1
END
@END
@TITLE FTN14.4(1,11)
@COL 1S-2T-3R-4T-6T-7R-8N
@COL 9R-10F-11R
@ROW 3-9
@FLOW 1-2N-3-4N-6N-7-8-4Y-10
@FLOW 2Y-9-10
@FLOW 6Y-11-8
@BOX 1.0
IMPORT DIRECTIVE
@BOX 2.0
NOT AT START OF PROGRAM?
@BOX 3.0
SELECT FIRST ARGUMENT
@BOX 4.0
NO MORE ARGUMENTS
@BOX 6.0
SEARCH LIBRARIES
PROCEDURE NOT FOUND?
@BOX 7.0
DECLARE PROCEDURE
@BOX 9.0
FAULT
@BOX 10.0
END
@BOX 11.0
FAULT
@BOX 1.1
;PROC IMPORT.DIRECTIVE
;$IN AP, I, J
;ADDR [$LO8] P
;ADDR A
;$LO32 FN
;ADDR GLOBAL.PROP GP
@BOX 2.1
;IF PU.G /= 5
@BOX 3.1
;STAT.AP.G - 2 => AP
@BOX 4.1
;IF AS[2+>AP] => J = -1
@BOX 6.1
;IF AS[AP+1] /= 0 THEN
   ;GLOB OF PROPS.T[J] => GP
   ;NAME OF G.NAME OF GP^ => P
   ; SIZE(P) => I
;ELSE
   ;ADDRESS OF PROPS.T[J] => A;
   ;MAKE($LO8,4095,A) => P
   ;0 => I
  ;WHILE P^[1+>I] /= 0 DO OD
   ;PART(P,1,1->I) => P
;FI
;IF FINDN(P,0) => FN = 0
@BOX 7.1
;DECLARE.LIB.PROC(P,I,FN)
@BOX 9.1
;FAULT(138,6)
@BOX 10.1
END
@BOX 11.1
;P=>F.B.G
;FAULT(139,7)
@END
@TITLE FTN14.5(1,10)
@COL 1S-2T-3R-4T-5R
@COL 6R-7F
@ROW 3-6
@FLOW 1-2N-3-4N-5-4Y-7
@FLOW 2Y-6-7
@BOX 1.0
LIB DIRECTIVE
@BOX 2.0
NOT AT START OF PROGRAM?
@BOX 3.0
OPEN SPECIFIED LIBRARY
@BOX 4.0
ANY MORE PROCEDURES IN LIBRARY?
@BOX 5.0
DECLARE LIBRARY PROCEDURE
@BOX 6.0
FAULT
@BOX 7.0
END
@BOX 1.1
;PROC LIB.DIRECTIVE
;ADDR[$LO8] P
;$LO8 [64] NBUFF
;ADDR A
;$LO32 FN
;$IN I,K
@BOX 2.1
;IF PU.G /= 5
@BOX 3.1
;ADDRESS OF PROPS.T[AS[STAT.AP.G]] => A
;MAKE($LO8,4095,A) => P
;0 => I
;WHILE P^[1+>I] /= 0 DO OD
;PART (P,1,I-1) => P
;LIBRARY(P,0)
;0 => I
@BOX 4.1
;IF LOOK.UP.N(1+>I,P,^NBUFF) => FN = 0
@BOX 5.1
;DECLARE.LIB.PROC(PART(^NBUFF,1,NBUFF[0]=>K),K,FN)
@BOX 6.1
;FAULT(138,6)
@BOX 7.1
END
@END
@TITLE FTN14.6(1,11)
@COL 1S-2R-3R-4R-5F
@FLOW 1-2-3-4-5
@BOX 1.0
DECLARE.LIB.PROC
@BOX 2.0
TRUNCATE PROC NAME IF TOO LONG
ADD TO GLOBAL PROPERTIES
DECLARE PROC TO MUTL
@BOX 3.0
DECLARE ALL PARAMS TO MUTL
AND NOTE SPECS
TAKE ACCOUNT THAT ONE FORTRAN CHARACTER
ARGUMENT IS HANDLED AS
TWO MUTL PROC PARAMETERS
@BOX 4.0
DECLARE RESULT TO MUTL
NOTE SPEC
@BOX 5.0
END
@BOX 1.1
;PROC DECLARE.LIB.PROC(NAME,SZ,MN)
;ADDR [$LO8] Q
;NAME.T FN
;$IN NPAR, J, K, I,DONE
;ADDR GLOBAL.PROP GP
;P.SPEC FTN.TYPE($LO8,$IN,$IN)
#FTN14.6.1
@BOX 2.1
;TL.PROC.SPEC(NAME,%8008)
;NAME => NAME OF FN
;ADD.G.NAME(^FN) => GP
;MUTLN.G => G.TL.NAME OF GP^ + 1 => MUTLN.G
@BOX 3.1
;FIND.P(MN,-1,0) => NPAR
;MAKE.LO8(NPAR*2+3,GLOBAL.SPACE) => Q
;0 => J => I => Q^[0] => DONE
;WHILE J < NPAR DO
   FTN.TYPE(FIND.P(MN,-1,1+>J) => K, MUTL.ARG.TYPE.Z.L,2 +>I)
   ;TL.PROC.PARAM(K,0)
    ;IF Q^[I] = %2D THEN 0 => DONE FI
    ;IF Q^[I] = %23 AND Q^[I-2] = %2D AND DONE = 0 THEN
      ;2 -> I ; 1 => DONE
   ;FI
;OD
;%FF => Q^[2+>I] :: ??? JM 17-FEB-83
;PART(Q,0,I) => G.ARG.SPEC.P OF GP^ :: ??? JM 17-FEB-83
@BOX 4.1
;FTN.TYPE(FIND.P(MN,-1,NPAR+1) => K, RES.TYPE.Z.L,0)
;TL.PROC.RESULT(K)
;%F => G.KIND OF GP^
@BOX 5.1
END
@END
@TITLE FTN14.6.1(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
FTN.TYPE
@BOX 2.0
SEARCH TABLE FOR
MUTL TYPE
RETURN FORTRAN TYPE
@BOX 3.0
END
@BOX 1.1
;PROC FTN.TYPE(MUTL,BND,J)
;$IN I
@BOX 2.1
;-3 => I
;WHILE 3 +> I < BND AND
   MUTL.ARG.TYPES[I] /= MUTL DO OD
;IF I >= BND THEN
   %81 => Q^[J]; 0 => Q^[J+1];
ELSE MUTL.ARG.TYPES[I+1] => Q^[J]
   ; MUTL.ARG.TYPES[I+2] => Q^[J+1]
   ;IF BND = RES.TYPE.Z.L THEN
      %F &> Q^[J] FI
FI
@BOX 3.1
END
@END
@TITLE FTN14.8(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
SHORT.INT
@BOX 2.0
CHANGE DEFAULT INTEGER SIZE
@BOX 3.0
END
@BOX 1.1
;PROC SHORT.INT
@BOX 2.1
; 1 => I.ACC.Z.G => ACC.Z.G[3]
    => L.ACC.Z.G => ACC.Z.G[4]
@BOX 3.1
; END
@END
@TITLE FTN14.9(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
MAP.COMMON
@BOX 2.0
DO TL.SEG
DO TL.LOAD
UPDATE COMMON PROPERTY
@BOX 3.0
END
@BOX 1.1
;PROC MAP.COMMON
;ADDR COMMON.PROP C.P
;ADDR Z
;$IN P,SEG
;COM OF PROPS.T[AS[STAT.AP.G=>P]] => C.P => F.C.PROP.G
;IF C.KIND OF C.P^ /= 0 THEN FAULT(24,2)
 ELSE
     TL.SEG (GET.SEG() => SEG,INT OF PROPS.T[AS[P+1]]=>Z,
        INT OF PROPS.T[AS[P+2]],INT OF PROPS.T[AS[P+3]],
        INT OF PROPS.T[AS[P+4]] & %FFFD )
    ;TL.LOAD(SEG,1+>MUTL.DA.N.G)
    ;MUTL.DA.N.G => C.AREA.NO OF C.P^
    ;Z => C.SIZE OF C.P^
    ;TL.COMMON (NAME OF C.NAME OF C.P^, 0, MUTL.DA.N.G!%4000)
 FI
@BOX 3.1
END
@END

