@X @~
~L3 COUK1247
80
~V7 56 2 -5
~D10
~H                 MUSS
~
~
~D10
~H             FTN131
~D10
~MMANCHESTER UNIVERSITY  -  CONFIDENTIAL~
~
~
                                                            ISSUE 11~
~V9 -1
~P
~V9 1
~YFTN131
~S1~M~OFORTRAN 77 COMPILER IMPLEMENTATION DESCRIPTION
~S1~M~OSection 13~
~S1~OSection 13. Fault Monitoring
~S1~O1.1 General Description
~BThe fault monitoring procedure (FAULT) is called when a fault in
the Source Program is detected at any stage of the compilation process.
The fault procedure prints out the lines containing the offending
FORTRAN statement, and where possible an indication
of the faults approximate position is also given. The fault, or faults
are listed underneath. The procedure keeps a tally of the number of
fatal and warning messages produced. The fault procedure is supplied
with a fault number which it translates into the form of a message
for output. Some messages (semantic errors) may have information from
the statement included in them.
~BSome faults may be buffered up by the fault procedure until a
suitable time for them to be printed.
~BAs the other procedures in this section interface one
debug diagnostic procedures, they may be removed on
installing the compiler.~
~BThe debug procedures are part of the external interface
of the compiler. Therefore, these procedures are
envokeable from program control sequence level.
These are generally used in one of three ways.
When debugging online
via a terminal and the compiler 'blows up' in
a Fortran compilation, these procedures may be called from
the program control level to examine the
compilers tables. In diagnosing some faults it may
be useful to envoke calls to the debug procedures at pertinent
points in compiling the source program, to do this the
appropriate debug procedures with ** in front
of them are added to the source program. Lastly the
INFORM procedure enables debug monitoring to
appear automatically while each statement is processed or
at the end of each program unit.~
~S1~O2. Interfaces
~S1~O2.1 Section Interfaces used
~
   Section  1: (Configuration Section)~
   Section  2: (Statement Driver)~
   Section  3: (Lexical Analysis)~
   Section  4: (Syntax Analysis)~
   Section  6: (Specification Part Declarations)~
   Section 12: (Property List Management)~
~S1~O2.2 Section Interfaces~
~
Exported Scalars:~
   LEX.FAULT.G~
   LEX.WARN.G~
   WARN.CNT.G~
   ERROR.CNT.G~
   F.L.PROP.G~
   F.G.PROP.G~
   F.C.PROP.G~
   F.S.PROP.G~
   F.L.PROP.ADDR.G~
   INFORM.LINE.G~
   INFORM.PV.G~
   FMT.TBL.SZ.G~
~
Exported Procedures:~
   FAULT~
~
Library Procedures:~
   INFORM~
   MONITOR~
   OUT.G~
   OUT.C~
   OUT.L~
   OUT.S~
   OUT.AR~
   OUT.LI~
   OUTF~
~S1~O3. Implementation
~S1~O3.1. Outline of Operation
~S1~OFAULT(FAULT.NO,DETAILS)~
~BThe bottom 8 bits of FAULT.NO specify the fault number. If bit 8 of
FAULT.NO is set the error is non fatal i.e. program or library will be
defined at end of compilation. If the DETAILS parameter is negative it
contains the negated index of the approximate position of the error
within the itemised line. A value of zero for DETAILS indicates a
lexical error. A positive value indicates the kind of additional
information to be printed with the error message.~
~3
~
~M1 - Print name of local property entry~
~N    pointed at by F.L.PROP.G~
~N2 - Print name of common property entry~
~N    pointed at by F.C.PROP.G~
~N3 - Print name of statement label entry~
~N    pointed at by F.S.PROP.G~
~N4 - Print label of global property entry~
~N    pointed at by F.G.PROP.G~
~N5 - Print name of local property entry~
~N    at address F.L.PROP.ADDR.G~
~N6 - Name not known, output a space~
~N7 - Print name specified by the bounded byte~
~N    vector pointer F.B.G.
~0
~BThe FAULT procedure may be called from any phase of the compiler.
There may be fatal errors and warning messages from the Lexical Analyser,
the Syntactic Analyser and the Semantic Processing. There are two
parameters to the FAULT procedure, the first indicates the type and
severity of the error, and the second indicates from which phase
the fault originated and provides optional information to be
included in the message.
~BIf the error number in between 1-255 it is a fatal error, if it is
between 256-511 it is a warning message.
If the second parameter (DETAILS)
is zero this indicates a lexical fault (because no further information
is needed for lexical fault), if this parameter is negative it indicates
a syntactic error and gives an indication of the errors position in the
current statement, if this parameter is positive it indicates
what should be printed with the message.~
~BLexical faults are detected while the buffer containing the source
statement is being filled, consequently the lexical fault messages
cannot be output directly but must be buffered up until the lexical
phase is complete. When a syntactic or semantic fault is detected for
a statement, it is clear that the lexical phase for that statement
is complete. It is assumed that there will be few enough lexical errors
to store them as bits in a word. It is assumed that syntactic and
semantic faults are mutually exclusive for any one statement; if a
statement is syntactically faulty then no semantic processing can occur.
It is also assumed that there will only be one syntactic fault in any
one statement, the syntactic phase aborting at the first detected fault.
The position of the scan at time of the syntactic fault is passed as a
negative value in the second parameter, this however is a position
in the itemised line generated by the lexical phase, and FAULT needs
to find the corresponding position in the source line to mark on the
output message.
~BA fault number of zero is used to mark the end of processing a
statement and enables any un-printed message which has been buffered
up to be output, before processing continues with the next statement.
~S1~O3.1.1 Output generated
~BIf there is a syntactic fault in a statement the source line is
printed out preceded by its page and line number in the source file.
The position indicator is printed in the appropriate place. After the
statement is printed the syntactic fault message is printed followed
by messages for any lexical errors which are buffered up.
~BIf there is a semantic fault the source line is printed, if it has
not already been done, followed by any lexical faults and then the semantic
fault message.
~Q 18
~BThe output has the following format:~
~3
~Q 12
~
   p.lll  LABEL STATEMENT~
                  ^~
               X  MORE STATEMENT~
       .~
       .~
       .  Etc.~
   *WARNING* WARN MESSAGE~
   **ERROR** ERROR MESSAGE~
       .~
       .~
       .  Etc.~
~0
~BWhere p and l represent the page and line number respectively, and X
represents any continuation column marker.
~S1~OINFORM(MODE)~
~BThis procedure specifies what debug monitoring is required for each
statement compiled and for each program unit compiled. The bottom 16
bits specify the statement monitoring and the next 16 bits the program
unit monitoring. Both these 16 bits are encoded as follows:~
~3
~
Bit  8 = 1  Allocate non static variable on stack~
Bit  9 = 1  Print analysis record, input statement and itemised line~
Bit 10 = 1  Print global and common property entries~
Bit 11 = 1  Print local property entries~
Bit 12 = 1  Print statement label entries~
Bit 13 = 1  Switch on statement listing~
Bit 14 = 1  Switch off argument type checking~
Bit 15 = 1  ** Commands interpreted~
~0
~
~
~S1~OMONITOR(MODE)~
~BThe appropriate debig OUT procedures are caled to print the compilers
tables as specified by MODE. It is encoded as the fields of MODE in
INFORM.~
~S1~OOUT.G()~
~BPrint the compilers global property entries.~
~S1~OOUT.C()~
~BPrint the compilers common property entries.~
~S1~OOUT.L()~
~BPrint the compilers local property entries.~
~S1~OOUT.S()~
~BPrints the compilers statement label properties.~
~S1~OOUT.AR()~
~BPrints the compilers analysis record stack.~
~S1~OOUT.LI()~
~BPrints the current statement and the itemised statement.~
~S1~OOUT.F~
~BPrints the format table and the format character table.~
~S1~O3.2 Data Structure~
~T# 17
~
LEX.WARN.G
~Ia bit list of stored lexical warning errors.~
~
LEX.FAULT.G
~Ia bit list of stored lexical fatal errors.~
~
WARN.CNT.G
~ICount of non-fatal errors.~
~
ERROR.CNT.G
~ICount of fatal errors.~
~
F.L.PROP.G
~IPointer to local property entry whose name will be printed with error
message.~
~
F.G.PROP.G
~IPointer to global property entry whose name will be printed with error
message.~
~
F.C.PROP.G
~IPointer to common property entry whose name will be printed with error
message.~
~
F.S.PROP.G
~IPointer to label property entry whose label value will be printed with
error message.~
~
F.L.PROP.ADDR.G
~IAddress of a local property entry whose name will be printed with
message.~
~
F.B.G~
~IPointer to a vector of bytes whose value will be printed with
error message.~
~Y
~V9 -1
~P
~D15
~HFLOWCHARTS
~
~
~H             FTN131
~V9 -1
~F
@TITLE FTN13(1,11)
@COL 1S-5R-6R-7R-9R-10R-4F
@FLOW 1-5-6-7-9-10-4
@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
22-DEC-82 (BCT) New release of this section
MONITORING SECTION
@BOX 5.0
EXTERNAL ENVIRONMENT[FTN13/1]
MODULE HEADING
@BOX 6.0
EXPORTED GLOBAL DECLARATIONS
@BOX 7.0
INTERNAL GLOBAL DECLARATIONS
@BOX 4.0
END
@BOX 9.0
FAULT:13.1:
COMPILER DEBUG PROCS
INFORM:13.2:
MONITOR:13.3:
OUT.G:13.4:
OUT.C:13.5:
OUT.L:13.6:
OUT.S:13.7:
OUT.AR:13.8:
OUT.LI:13.9:
OUT.F:13.10:
@BOX 10.0
COMMON OUTPUT PROCS USED BY
COMPILER DEBUG PROCS
OUT.NAME:13.20:
OUT.B:13.20:
OUT.A:13.20:
OUT.16:13.20:
@BOX 5.1
#FTN13/1
;MODULE (FAULT,INFORM,MONITOR,OUT.G,OUT.C,OUT.L,OUT.AR,OUT.LI,OUT.S,OUT.F,
        LEX.FAULT.G,ERROR.CNT.G,F.I.G,PRINT.CLASS.MESS,
        INFORM.LINE.G,DEBUG.LINE.G,F.L.PROP.G,F.G.PROP.G,F.C.PROP.G,F.S.PROP.G,
        F.L.PROP.ADDR.G,FMT.TBL.SZ.G,F.B.G,DEBUG.PU.G,ANSI.BITS.G);
@BOX 6.1
; *GLOBAL 2
;$IN32 F.I.G
;$IN LEX.FAULT.G  :: @@@ BCT 22-DEC-82
;$LO32 INFORM.LINE.G,ANSI.BITS.G
;$LO16 DEBUG.PU.G,DEBUG.LINE.G
;$IN F.L.PROP.ADDR.G
;ADDR LOCAL.PROP F.L.PROP.G
;ADDR GLOBAL.PROP F.G.PROP.G
;ADDR COMMON.PROP F.C.PROP.G
; ADDR LABEL.PROP F.S.PROP.G
; ADDR [$LO8] F.B.G
;$IN FMT.TBL.SZ.G
;LITERAL/ADDR [$LO8] NIL.STR =
; $IN [ERROR.CLASS.L] ERROR.CNT.G  :: @@@ BCT 22-DEC-82
#FTN13/2
; *GLOBAL 0
@BOX 9.1
;PSPEC PRINT.CLASS.MESS($IN)
;LSPEC FAULT($IN,$IN) :: @@@ BCT 04-JAN-82 Temporary change
;LSPEC INFORM($LO32,$LO32,$LO32)
;LSPEC MONITOR($IN)
;LSPEC OUT.G()
;LSPEC OUT.C()
;LSPEC OUTL()
;LSPEC OUTS()
;LSPEC OUTAR()
;LSPEC OUTLI()
;LSPEC OUTF()
#FTN13.0
#FTN13.1
;PSPEC OUT.N(ADDR [$LO8])
;PSPEC OUT.B($IN)
;PSPEC OUT.A($IN)
;PSPEC OUT.16($IN)
#FTN13.2
#FTN13.3
#FTN13.4
#FTN13.5
#FTN13.6
#FTN13.7
#FTN13.8
#FTN13.9
#FTN13.10
@BOX 10.1
#FTN13.20
@BOX 4.1
;*END
@END
@TITLE FTN13/1(1,11)
@COL 1S-2R-3R-4R-5R-6F
@FLOW 1-2-3-4-5-6
@BOX 1.0
EXTERNAL ENVIRONMENT
@BOX 2.0
TYPES
@BOX 3.0
LITERALS
@BOX 4.0
VARIABLES
@BOX 5.0
PROCEDURES
@BOX 6.0
END
@BOX 1.1
@BOX 2.1
; IMPORT TYPE EQUIV.PROP, CONST.PROP
;TYPE PROPS;
;TYPE NAME.T IS $AD[$LO8] NAME :: ??? JM 29-DEC-82
;TYPE LOCAL.PROP;
;TYPE GLOBAL.PROP IS
       ADDR GLOBAL.PROP G.NEXT.P
       NAME.T G.NAME
       $LO8 G.KIND
       $LO16 G.TL.NAME
       ADDR [$LO8] G.ARG.SPEC.P
;TYPE L.ALT.TYPE IS
       ADDR CONST.PROP L.CONST.P OR
       ADDR EQUIV.PROP L.EQT.P
       $IN L.DISP OR
       ADDR [$LO8] L.ARG.SPEC.P
       $LO8 L.INTR.NO
       $LO16 L.CH.RES.NAME
       $LO16 L.SPEC.TL.NAME OR
       ADDR [$IN] L.AS.DUMP
       ADDR [PROPS] L.PROPS.T.DUMP
;TYPE LOCAL.PROP IS
       ADDR LOCAL.PROP L.NEXT.P
       NAME.T L.NAME
       ADDR LOCAL.PROP L.LINK1, L.LINK2
       $LO8 LTYPE
       $LO16 LSPECS, LKIND
       $IN L.LEN
       $LO16 L.TL.NAME
       ADDR [$IN] L.ARR.SPEC.P
       L.ALT.TYPE L.ALT
;TYPE COMMON.PROP IS
       ADDR COMMON.PROP C.NEXT.P
       NAME.T C.NAME
       $LO8 C.KIND
       ADDR LOCAL.PROP C.HEAD, C.TAIL
       ADDR C.SIZE
       ADDR COMMON.PROP C.PREV.P
       $LO8 C.AREA.NO
;TYPE LABEL.PROP IS
       ADDR LABEL.PROP S.NEXT.P
       $LO24 S.NAME
       $LO8 S.KIND
       $LO16 S.LEVEL, S.BLOCK, S.TL.NAME, S.ID
;TYPE PROPS IS
       $IN32 INT OR
       ADDR ADDRESS OR
       ADDR LOCAL.PROP LOC OR
       ADDR GLOBAL.PROP GLOB OR
       ADDR COMMON.PROP COM OR
       ADDR CONST.PROP CONST
@BOX 3.1
;IMPORT LITERAL INLINE.SZ.L,GLOBAL.HASH.Z.L,COMMON.HASH.Z.L,LOCAL.HASH.Z.L,LABEL
.HASH.Z.L,
     MAX.FMT.TABLE.L,MAX.FMT.STRINGS.L,LINE.SZ.L,AS.Z.L,PROPS.Z.L,MAX.LINE.POSIT
ION
;IMPORT LITERAL $LO8 SPACE.L,TAB.L,NL.L,NP.L,MARK.HOL.L,L.EQ.L,L.NE.L,L.LE.L,
               L.GE.L,L.LT.L,L.GT.L,L.OR.L,L.AND.L,L.NOT.L,L.EQV.L,
               L.NEQV.L,L.TRUE.L,L.FALSE.L
;IMPORT LITERAL ERROR.CLASS.L
@BOX 4.1
;$IN16[MAX.FMT.TABLE.L] FMT.TABLE :: FTN04
;$LO8[MAX.FMT.STRINGS.L] FMT.STRINGS :: FTN04
; $LO8 [LINE.SZ.L] LINE.G     ::FTN03
; $LO8 [INLINE.SZ.L] INLINE.G     ::FTN03
; ADDR GLOBAL.PROP [GLOBAL.HASH.Z.L] G.HASH
; ADDR COMMON.PROP [COMMON.HASH.Z.L] C.HASH
; ADDR LOCAL.PROP [LOCAL.HASH.Z.L] L.HASH
; ADDR LABEL.PROP [LABEL.HASH.Z.L] S.HASH
; ADDR COMMON.PROP BLANK.COM.G
; ADDR GLOBAL.PROP G.CUR.PU :: @@@ BCT 31-DEC-82
; $IN MON.STR,STAT.AP.G
; LABEL ABORT.COMPILE,RESTART.COMPILE :: @@@ BCT 23-DEC-82
; $LO8 PU.G :: @@@ BCT 31-DEC-82
; $IN [AS.Z.L] AS
; PROPS[PROPS.Z.L] PROPS.T
; $IN32 CUR.LIN.PAG.G
@BOX 5.1
;LSPEC SELECT.OUTPUT($IN);
;LSPEC NEWLINES($IN)
;LSPEC SPACES($IN)
::CV ;PSPEC OUTHEX($LO32,$IN)
;LSPEC OUTHEX($LO32,$IN)
;LSPEC CAPTION(ADDR [$LO8])
;LSPEC OUTCH($IN)
;LSPEC OUTI($IN32,$IN)
;LSPEC OUT.LINE.NO($IN32)
;LSPEC I.POS()/$IN32
@END
@TITLE FTN13/2(1,11)
@COL 1S
@FLOW 1
@BOX 1.0
DATAVEC OF CLASS NAMES
@BOX 1.1
:: @@@ BCT 22-DEC-82 Start of insert
; *GLOBAL 7
;DATAVEC FATAL($LO8)
" **ERROR** "
END
;DATAVEC WARNING($LO8)
" *WARNING* "
END
;DATAVEC ANSI($LO8)
" ***ANSI** "
END
;DATAVEC ABORT($LO8)
" *ABORTING "
END
;DATAVEC CLASS.MESSAGE.L(ADDR [$LO8])
FATAL WARNING ANSI ABORT
END
; *GLOBAL 0
:: @@@ BCT 22-DEC-82 End of insert
@END

@TITLE FTN13.0(1,11)
@COL 1S-2R-3F
@BOX 1.0
PRINT.CLASS.MESS(NO)
@BOX 2.0
PRINT CLASS MESSAGE
@BOX 3.0
END
@BOX 1.1
; PROC PRINT.CLASS.MESS(CLASS)
@BOX 2.1
; CAPTION(CLASS.MESSAGE.L[CLASS])
@BOX 3.1
; END
@END
@TITLE FTN13.1(1,11)
@COL 1S-24T-22R-3T-23T-6T-10N-8T-9R-14R-13T-21T-15F
@COL 4R-5C-7R-2C-20C
@FLOW 3N-23N-6N-10-8N-9-14-13N-21NO-15
@FLOW 23Y-5
@FLOW 1-24N-22-3Y-4-5
@FLOW 24Y-6Y-7-8Y-14-13Y-2
@FLOW 21YES-20
@ROW 23-4
@ROW 21-2
@ROW 10-7
@BOX 1.0
PROC FAULT(FAULTNO,DETAILS)
@BOX 3.0
LEXICAL FAULT?
@BOX 4.0
ADD TO BIT LIST
@BOX 5.0
END
@BOX 6.0
STATEMENT TO PRINT?
@BOX 7.0
PRINT STATEMENT :13.1.1:
@BOX 8.0
NO MESSAGE?
@BOX 9.0
PRINT MESSAGE :13.1.2:
@BOX 13.0
LEXICALS TO PRINT?
@BOX 14.0
PRINT LEXICAL FAULTS :13.1.3:
@BOX 13.0
ABORT CLASS?
@BOX 2.0
ABORT COMPILATION
@BOX 15.0
END
@BOX 20.0
QUIT THIS STATEMENT
@BOX 21.0
RESTART COMPILE?
@BOX 22.0
VALIDATE FAULT MESSAGE
@BOX 23.0
THIS MESSAGE SUPPRESSED?
@BOX 24.0
ONLY LINE PRINTED?
@BOX 1.1
;PROC FAULT(SPECIFIER, DETAILS) :: ??? JM 4-JAN-83
;LITERAL INVALID.FAULT.NO = 8
::; IF INFORM.LINE.G & %FFBF /= 0 THEN
::;CAP(%"FAULT");OUTI(FAULT.NO,6);OUTI(DETAILS,6);NEWLINES(1)
::FI
;$IN I,J,TEMP,CLASS,LINE.USED,SPACES.UP,FAULT.NO,RESTART
;$LO8 CH :: ??? JM 24-FEB-83
;$LO32 MODE.MASK :: JM 24-FEB-83
;$AD [$LO8] MESSAGE :: ??? JM 23-FEB-83
#FTN13.1.0.1
#FTN13.1.0.2
#FTN13.1.0.3
DATAVEC FAULT.MESSAGE($LO8)
#FTN13.1.0.4
#FTN13.1.0.5
#FTN13.1.0.6
#FTN13.1.0.7
END
;P.SPEC PRINT.MESSAGE($AD [$LO8], $IN)
#FTN13.1.2
@BOX 3.1
 :: ??? JM 4-JAN-83
;IF DETAILS =0 AND SPECIFIER > 0
@BOX 4.1
; 1 <<- FAULT.NO ! > LEX.FAULT.G :: @@@ BCT 22-DEC-82
@BOX 5.1
EXIT
@BOX 6.1
:: @@@ BCT 22-DEC-82
;IF INLINE.G[0] /= 0 AND
   [LEX.FAULT.G /= 0 OR SPECIFIER /= 0 OR  DETAILS /= 0]
@BOX 7.1
#FTN13.1.1
@BOX 8.1
 :: ??? JM 24-FEB-83
;IF DETAILS = 0 OR SPECIFIER =< 0
@BOX 9.1
;PRINT.MESSAGE(MESSAGE,DETAILS)
@BOX 14.1
#FTN13.1.3
@BOX 13.1
:: @@@ BCT 23-DEC-82
;IF CLASS = 3
@BOX 2.1
; -> ABORT.COMPILE :: @@@ BCT 23-DEC-82
@BOX 15.1
END
@BOX 20.1
 :: ??? JM 4-JAN-83
;->RESTART.COMPILE
@BOX 21.1
 :: ??? JM 4-JAN-83
;IF RESTART /=0
@BOX 22.1
;SPECIFIER & %FF => FAULT.NO
;IF FAULT.NO > 0 AND [SIZE(^FAULT.INDEX) =< FAULT.NO OR
    SIZE(^FAULT.MESSAGE) => TEMP =< (FAULT.INDEX[FAULT.NO-1]=>I-1) OR
    TEMP =< (FAULT.INDEX[FAULT.NO]-2 => J)]
 THEN  FAULT.NO => F.I.G
      ;8 => DETAILS
      ;FAULT.INDEX[INVALID.FAULT.NO => FAULT.NO-1] => I
      ;FAULT.INDEX[FAULT.NO]-2 => J
 FI
;PART (^FAULT.MESSAGE, I, J) => MESSAGE
@BOX 23.1
; FAULT.MESSAGE [I-1] => CH ->> 5 => CLASS
; %1F &> CH
; IF CH = 0 THEN 0 => MODE.MASK
  ELSE 1 -> CH ; 1 <<- CH => MODE.MASK FI
; IF MODE.MASK & ANSI.BITS.G /= 0
@BOX 24.1
;IF DETAILS > 0 THEN
    DETAILS & %1000 => RESTART :: ??? JM 4-JAN-83
    ;%FF &> DETAILS
 ELSE 0 => RESTART FI
; -1 => CLASS
; IF SPECIFIER =< 0
@END


@TITLE FTN13.1.0.1(1,10)
@COL 1S
@BOX 1.0
MESSAGE LENGTH LITERALS
@BOX 1.1
::M LITERALS LENGTH OF MESSAGES
;LITERAL/$LO16
M1   = 20 , M2   = 44 , M3   = 31 , M4   = 20 ,
M5   = 27 , M6   =  9 , M7   =  9 , M8   = 27 ,
M9   = 24 , M10  = 22 , M11  = 23 , M12  = 20 ,
M13  = 37 , M14  = 25 , M15  = 27 , M16  = 34 ,
M17  = 23 , M18  = 21 , M19  = 29 , M20  = 20 ,
M21  = 27 , M22  = 29 , M23  = 14 , M24  = 18 ,
M25  = 33 , M26  = 18 , M27  = 50 , M28  = 43 ,
M29  = 40 , M30  = 33 , M31  = 25 , M32  = 37 ,
M33  = 29 , M34  = 27 , M35  = 52 , M36  = 22 ,
M37  = 37 , M38  = 34 , M39  = 37 , M40  = 50 ,
M41  = 27 , M42  = 16 , M43  = 20 , M44  = 38 ,
M45  = 28 , M46  = 28 , M47  = 30 , M48  = 17 ,
M49  = 43 , M50  = 34 , M51  = 21 , M52  = 25 ,
M53  = 57 , M54  = 27 , M55  = 43 , M56  = 56 ,
M57  = 40 , M58  = 22 , M59  = 51 , M60  = 35 ,
M61  = 29 , M62  = 44 , M63  = 38 , M64  = 43
;LITERAL/$LO16
M65  = 35 , M66  = 20 , M67  = 32 , M68  = 36 ,
M69  = 34 , M70  = 23 , M71  = 22 , M72  = 23 ,
M73  = 37 , M74  = 41 , M75  = 25 , M76  = 67 ,
M77  = 42 , M78  = 29 , M79  = 22 , M80  = 40 ,
M81  = 23 , M82  = 57 , M83  = 54 , M84  = 37 ,
M85  = 53 , M86  = 26 , M87  = 34 , M88  = 57 ,
M89  = 42 , M90  = 29 , M91  = 42 , M92  = 40 ,
M93  = 41 , M94  = 42 , M95  = 47 , M96  = 32 ,
M97  = 42 , M98  = 54 , M99  = 52 , M100 = 33 ,
M101 = 31 , M102 = 26 , M103 = 29 , M104 = 33 ,
M105 = 43 , M106 = 34 , M107 = 14 , M108 = 29 ,
M109 = 35 , M110 = 35 , M111 = 40 , M112 = 20 ,
M113 = 29 , M114 = 25 , M115 = 32 , M116 = 56 ,
M117 = 25 , M118 = 35 , M119 = 21 , M120 = 11 ,
M121 = 18 , M122 = 27 , M123 = 22 , M124 = 42  ,
M125 = 44 , M126 = 48 , M127 = 33 , M128 = 27
;LITERAL/$LO16
M129 = 24 , M130 = 46 , M131 = 51 , M132 = 30 ,
M133 = 24 , M134 = 20 , M135 = 46 , M136 = 22 ,
M137 = 21 , M138 = 51 , M139 = 41 , M140 = 25,
M141 = 27 , M142 = 31 , M143 = 22 , M144 = 34 ,
M145 = 17 , M146 = 43 , M147 = 14 , M148 = 13 ,
M149 = 25 , M150 = 45 , M151 = 52 , M152 = 105,
M153 = 39 , M154 = 47 , M155 = 55 , M156 = 48 ,
M157 = 78 , M158 = 70 , M159 = 64 , M160 = 27 ,
M161 = 63 , M162 = 41 , M163 = 58 , M164 = 133 ,
M165 = 56 , M166 = 50 , M167 = 66 , M168 = 50,
M169 = 34 , M170 = 42 , M171 = 35 , M172 = 36 ,
M173 = 37 , M174 = 39 , M175 = 39 , M176 = 58 ,
M177 = 61 , M178 = 35 , M179 = 35 , M180 = 40,
M181 = 51 , M182 = 0
@END
@TITLE FTN13.1.0.2(1,11)
@COL 1S
@BOX 1.0
MESSAGE INDEX LITERALS
@BOX 1.1
::P LITERALS POSITION OF MESSAGES
;LITERAL/$LO16
P1 = 1, P2 = 1+P1+M1, P3 = 1+P2+M2, P4 = 1+P3+M3,
P5 = 1+P4+M4, P6 = 1+P5+M5, P7 = 1+P6+M6, P8 = 1+P7+M7,
P9 = 1+P8+M8, P10 = 1+P9+M9, P11 = 1+P10+M10, P12 = 1+P11+M11,
P13 = 1+P12+M12, P14 = 1+P13+M13, P15 = 1+P14+M14, P16 = 1+P15+M15,
P17 = 1+P16+M16, P18 = 1+P17+M17, P19 = 1+P18+M18, P20 = 1+P19+M19,
P21 = 1+P20+M20, P22 = 1+P21+M21, P23 = 1+P22+M22, P24 = 1+P23+M23,
P25 = 1+P24+M24, P26 = 1+P25+M25, P27 = 1+P26+M26, P28 = 1+P27+M27,
P29 = 1+P28+M28, P30 = 1+P29+M29, P31 = 1+P30+M30, P32 = 1+P31+M31
;LITERAL/$LO16
P33 = 1+P32+M32, P34 = 1+P33+M33, P35 = 1+P34+M34, P36 = 1+P35+M35,
P37 = 1+P36+M36, P38 = 1+P37+M37, P39 = 1+P38+M38, P40 = 1+P39+M39,
P41 = 1+P40+M40, P42 = 1+P41+M41, P43 = 1+P42+M42, P44 = 1+P43+M43,
P45 = 1+P44+M44, P46 = 1+P45+M45, P47 = 1+P46+M46, P48 = 1+P47+M47,
P49 = 1+P48+M48, P50 = 1+P49+M49, P51 = 1+P50+M50, P52 = 1+P51+M51,
P53 = 1+P52+M52, P54 = 1+P53+M53, P55 = 1+P54+M54, P56 = 1+P55+M55,
P57 = 1+P56+M56, P58 = 1+P57+M57, P59 = 1+P58+M58, P60 = 1+P59+M59,
P61 = 1+P60+M60, P62 = 1+P61+M61, P63 = 1+P62+M62, P64 = 1+P63+M63
;LITERAL/$LO16
P65 = 1+P64+M64, P66 = 1+P65+M65, P67 = 1+P66+M66, P68 = 1+P67+M67,
P69 = 1+P68+M68, P70 = 1+P69+M69, P71 = 1+P70+M70, P72 = 1+P71+M71,
P73 = 1+P72+M72, P74 = 1+P73+M73, P75 = 1+P74+M74, P76 = 1+P75+M75,
P77 = 1+P76+M76, P78 = 1+P77+M77, P79 = 1+P78+M78, P80 = 1+P79+M79,
P81 = 1+P80+M80, P82 = 1+P81+M81, P83 = 1+P82+M82, P84 = 1+P83+M83,
P85 = 1+P84+M84, P86 = 1+P85+M85, P87 = 1+P86+M86, P88 = 1+P87+M87,
P89 = 1+P88+M88, P90 = 1+P89+M89, P91 = 1+P90+M90, P92 = 1+P91+M91,
P93 = 1+P92+M92, P94 = 1+P93+M93, P95 = 1+P94+M94, P96 = 1+P95+M95
;LITERAL/$LO16
P97 = 1+P96+M96, P98 = 1+P97+M97, P99 = 1+P98+M98, P100 = 1+P99+M99,
P101 = 1+P100+M100, P102 = 1+P101+M101, P103 = 1+P102+M102, P104 = 1+P103+M103,
P105 = 1+P104+M104, P106 = 1+P105+M105, P107 = 1+P106+M106, P108 = 1+P107+M107,
P109 = 1+P108+M108, P110 = 1+P109+M109, P111 = 1+P110+M110, P112 = 1+P111+M111,
P113 = 1+P112+M112, P114 = 1+P113+M113, P115 = 1+P114+M114, P116 = 1+P115+M115,
P117 = 1+P116+M116, P118 = 1+P117+M117, P119 = 1+P118+M118, P120 = 1+P119+M119,
P121 = 1+P120+M120, P122 = 1+P121+M121, P123 = 1+P122+M122, P124 = 1+P123+M123,
P125 = 1+P124+M124, P126 = 1+P125+M125, P127 = 1+P126+M126, P128 = 1+P127+M127
;LITERAL/$LO16
P129 = 1+P128+M128, P130 = 1+P129+M129, P131 = 1+P130+M130, P132 = 1+P131+M131,
P133 = 1+P132+M132, P134 = 1+P133+M133, P135 = 1+P134+M134, P136 = 1+P135+M135,
P137 = 1+P136+M136, P138 = 1+P137+M137,P139 = 1+P138+M138,P140 = 1+P139+M139,
P141 = 1+P140+M140,P142 = 1+P141+M141,P143 = 1+P142+M142,P144 = 1+P143+M143,
P145 = 1+P144+M144,P146 = 1+P145+M145,P147 = 1+P146+M146,P148 = 1+P147+M147,
P149 = 1+P148+M148,P150 = 1+P149+M149,P151 = 1+P150+M150,P152 = 1+P151+M151,
P153 = 1+P152+M152,P154 = 1+P153+M153,P155 = 1+P154+M154,P156 = 1+P155+M155,
P157 = 1+P156+M156,P158 = 1+P157+M157,P159 = 1+P158+M158,P160 = 1+P159+M159,
P161 = 1+P160+M160,P162 = 1+P161+M161,
P163 = 1+P162+M162,P164 = 1+P163+M163,P165 = 1+P164+M164,P166 = 1+P165+M165,
P167 = 1+P166+M166,P168 = 1+P167+M167,P169 = 1+P168+M168,P170 = 1+P169+M169,
P171 = 1+P170+M170,P172 = 1+P171+M171,
P173 = 1+P172+M172,P174 = 1+P173+M173,P175 = 1+P174+M174,P176 = 1+P175+M175,
P177 = 1+P176+M176,P178 = 1+P177+M177,P179 = 1+P178+M178,P180 = 1+P179+M179,
P181 = 1+P180+M180,P182 = 1+P181+M181,P183 = 1+P182+M182;
@END
@TITLE FTN13.1.0.3(1,6)
@COL 1S
@BOX 1.0
DATA VECTOR OF MESSAGE INDICES
IN MESSAGE VECTOR
@BOX 1.1
;DATAVEC FAULT.INDEX($LO16)
P1    P2    P3    P4    P5    P6    P7    P8
P9    P10   P11   P12   P13   P14   P15   P16
P17   P18   P19   P20   P21   P22   P23   P24
P25   P26   P27   P28   P29   P30   P31   P32
P33   P34   P35   P36   P37   P38   P39   P40
P41   P42   P43   P44   P45   P46   P47   P48
P49   P50   P51   P52   P53   P54   P55   P56
P57   P58   P59   P60   P61   P62   P63   P64
P65   P66   P67   P68   P69   P70   P71   P72
P73   P74   P75   P76   P77   P78   P79   P80
P81   P82   P83   P84   P85   P86   P87   P88
P89   P90   P91   P92   P93   P94   P95   P96
P97   P98   P99   P100  P101  P102  P103  P104
P105  P106  P107  P108  P109  P110  P111  P112
P113  P114  P115  P116  P117  P118  P119  P120
P121  P122  P123  P124  P125  P126  P127  P128
P129  P130  P131  P132  P133  P134  P135  P136
P137  P138  P139  P140  P141  P142  P143  P144
P145  P146  P147  P148  P149  P150  P151  P152
P153  P154  P155  P156  P157  P158  P159  P160
P161  P162  P163  P164  P165  P166  P167  P168
P169  P170  P171  P172  P173  P174  P175  P176
P177  P178  P179  P180  P181  P182  P183
END
@END
@TITLE FTN13.1.0.4(1,11)
@COL 1S
@BOX 1.0
FAULT MESSAGES 1 TO 50
@BOX 1.1
0 "initial card missing"
0 "columns 1-5 of a continuation card not blank"
0 "more than 19 continuation cards"
0 "incomplete Hollerith"
0 "end quote of string missing"
0 "message 6"
0 "message 7"
0 "unknown and obscure error @"
0 "DIMENSION specified for@"
0 "invalid EXTERNAL item@"


0 "invalid INTRINSIC item@"
0 "invalid COMMON item@"
0 "direct access READ cannot contain eof"
0 "invalid EQUIVALENCE item@"
0 "@has more than 7 subscripts"
0 "@has lower substring bound below 1"
0 "invalid PARAMETER item@"
0 "invalid item in SAVE@"
0 "IMPLICIT letters out of order"
0 "@already DIMENSIONed"


0 "@has more than 7 DIMENSIONs"
0 "@has lower bound > than upper"
0 "length below 1"
%1F "name@is not unique"
0 "earlier reference to@inconsistent"
0 "@must not be typed"
0 "only one of file or unit params allowed in INQUIRE"
0 "statement not allowed in a block IF or a DO"
0 "DATA item@of wrong type for this context"
0 "FORMAT statement must be labelled"


0 "* not allowed in FUNCTION"
0 "statement contains an illformed label"
0 "IF expression must be logical"
%20 "jump to following statement"
%20 "statement not on control path and will not be obeyed"
0 "@not an INTEGER scalar"
0 "alternate RETURNs only in SUBROUTINEs"
0 "expression must be of INTEGER type"
0 "logical IF expression must be logical"
0 "this statement is not permitted after a logical IF"


0 "this block IF overlaps a DO"
0 "too many END IFs"
0 "invalid DO parameter"
0 "variable@not of arithmetic scalar type"
0 "DO increment can not be zero"
%20 "this subprogram does nothing"
0 "DO loop or block IF incomplete"
0 "label@not defined"
0 "CALL operand@is not a valid SUBROUTINE name"
0 "RETURN not allowed in main program"
@END

@TITLE FTN13.1.0.5(1,10)
@COL 1S
@BOX 1.0
FAULT MESSAGES 51 TO 100
@BOX 1.1
0 "ELSE not allowed here"
0 "use of label@inconsistent"
%4F "non standard. label@causes a branch into a block IF or DO"
0 "DO loop overlaps a block IF"
0 "program contains more than one main program"
0 "IMPLICIT must precede all other specification statements"
0 "statement is not permitted in BLOCK DATA"
0 "faulty statement label"
0 "dummy argument of statement function@must be a name"
0 "constant list longer than name list"


0 "@is an invalid name list item"
0 "substring specifier values on item@incorrect"
0 "trip count of DO list must be positive"
0 "incorrect expression type for arithmetic IF"
0 "name list longer than constant list"
0 "invalid repeat count"
0 "constant type inconsistent item@"
0 "constant list item@is not a constant"
0 "output statement must not have eof"
0 "invalid recl expression"


0 "unit parameter missing"
0 "invalid unit expression"
0 "internal file cannot be direct access"
0 "unformatted not allowed to internal files"
0 "invalid FORMAT expression"
0 "list directed format not allowed on internal or direct access files"
0 "iolist items of READ cannot be expressions"
0 "changing DO control variable@"
0 "invalid expr in iolist"
0 "assumed size array@cannot be used in i/o"


0 "invalid unit expression"
0 "items between different COMMONs cannot be EQUIVALENCEd -@"
0 "COMMON block@cannot be extended on left by EQUIVALENCE"
0 "SAVE not used consistently on COMMON@"
%43 "CHARACTER cannot be mixed with other types in COMMON@"
%42 "COMMON block@of wrong size"
0 "invalid bound expression on array@"
0 "item@cannot be eqivalenced to different storage locations"
0 "@has wrong no of dimensions in EQUIVALENCE"
0 "scalar cannot have dimensions"


0 "dimensions out of bounds on equivalencing@"
0 "non CHARACTER item@cannot have substring"
0 "substring out of bounds on equivalencing@"
0 "item@has wrong no of subscript expressions"
0 "subscript on@cannot be variable in this context"
0 "invalid subscript expression on@"
0 "No. of arguments used with@is inconsistent"
0 "character and arithmetic types mixed for@argument No.@"
0 "a variable expression cannot be used in this context"
0 "constant expression of wrong type"
@END
@TITLE FTN13.1.0.6(1,10)
@COL 1S
@BOX 1.0
FAULT MESSAGES 101 TO 150
@BOX 1.1
0 "invalid substring specifier on@"
0 "substring on@out of bounds"
0 "string of known size required"
0 "illegal FUNCTION name@as argument"
0 "label arguments only allowed in SUBROUTINEs"
0 "illegal argument type with generic"
0 "invalid syntax"
%31 "inconsistent result type for@"
%31 "inconsistent type for@argument No.@"
%31 "inconsistent kind for@argument No.@"


%31 "inconsistent precision for@argument No.@"
0 "invalid operand kind"
0 "invalid operand type coercion"
0 "invalid type for operator"
0 "substring specifier illegal here"
0 "adjustable or assumed size array@is not a dummy argument"
%20 "main program unit missing"
%20 "following program units are missing"
%20 "label@already defined"
%20 "END missing"


0 "Hollerith too long"
0 "COMMON or DATA item too big"
0 "illegal use of (*) on@"
0 "COMMON@in a previous BLOCK DATA subprogram"
0 "ASSIGNed GOTO in program unit without ASSIGN"
0 "INTEGER variable format specifier without ASSIGN"
0 "subprogram@referenced incorrectly"
%49 "directly recursive call on@"
0 "DO label@used previously"
0 "too many procedure calls - compilation aborted"

0 "all 32 mutl segments consumed - compilation aborted"
0 "mutl segment invalid or in use"
0 "COMMON@previously MAPped"
0 "blank COMMON too big"
0 "MAP DATA directive not allowed in program unit"
0 "MAPped DATA space full"
0 "unable to initialise@"
0 "this directive only allowed at beginning of program"
0 "procedure@not found in any opened library"
%45 "name@exceeds 6 characters"

0 "SUBROUTINE@explicitly typed"
0 "dummy argument names not unique"
0 "subscript illegal here"
0 "invalid item on left of assignment"
%1F "compiler confused"
0 "the enclosing subprogram@should not be used"
0 "@already typed"
0 "is a constant"
%46 "this type is non-standard"
%4C "PARAMETER with no parenthesis is non-standard"
@END

@TITLE FTN13.1.0.7(1,11)
@COL 1S
@BOX 1.0
FAULT MESSAGES 151 TO 200
@BOX 1.1
%4D "data initialisation in a declaration is non-standard"
%20 "the last PARAMETER statement with no parentheses was ambiguous"
  " with an assignment - PARAMETER was assumed"
%47 "name@contains non-standard character(s)"
%44 "this use of Hollerith constants is non-standard"
%48 "hex or octal representation of integers is non-standard"
%48 "typeless hex or octal constants are non-standard"
%3F "floating point constant needs greater exponent size, processor"
    " default@assumed"
%3F "magnitude of integer constant exceeds processor limit, default@assumed"
%3F "hex or octal constant is too long for this processor - truncated"
%60 "program has too many errors"

%4B "this form of direct access READ/WRITE statement is non-standard"
%4C "ENCODE/DECODE statements are non-standard"
0   "first argument to ENCODE/DECODE must be integer expression"
%20 "an earlier reference to this subprogram may have contained an actual "
    "argument whose value can exceed the range of the dummy argument@"
%20 "Hollerith constant is too wide - truncated to@characters"
%20 "typeless constant is too wide - truncated to@bytes"
%50 "using a character string with arithmetic variables is non-standard"::m167
%4E "named COMMON@can only be initialised in BLOCK DATA"
%4E "blank COMMON cannot be initialised" ::m169
%44 "arithmetic array as format is non-standard"

%60 "internal table overflow: line space" ::m171
%60 "internal table overflow: local space"
%60 "internal table overflow: global space"
%20 "division by constant zero in expression"
%48 "Hex or Octal formatting is non-standard"
0 "label cannot be given to library routine@for argument No.@"
0 "library routine@argument No.@needs a type not used in Fortran"
0 "inconsistent type for@argument No.@"
0 "inconsistent kind for@argument No.@"
0 "inconsistent precision for@argument No.@"

0 "EXTERNAL SUBROUTINE name expected for@argument No.@"
@END

@TITLE FTN13.1.1(1,10)
@COL 1S-3R-4R-23T-5T-21N-8T-10T-11R-22T-9R-13N-14R-15F
@COL 20R-6T-7R
@ROW 8-7
@ROW 21-20
@FLOW 1-3-4-23N-5N-21-8N-10N-11-22N-9-13-23Y-14-15
@FLOW 5Y-20-6N-7-13
@FLOW 6Y-8Y-13
@FLOW 10Y-22Y-14
@BOX 1.0
PRINT STATEMENT
@BOX 3.0
CALCULATE POSITION IN LINE
@BOX 4.0
SELECT MONITORING STREAM
NEWLINES (0)
WRITE PAGE & LINE NUMBERS
WRITE LABEL FIELD
@BOX 23.0
NEXTCHAR = 0 ?
@BOX 5.0
WRITE CHAR
POSITION < 0 ?
@BOX 20.0
1 +> COUNT
@BOX 6.0
INSIG. CHAR ?
@BOX 7.0
1 +> POSITION
@BOX 8.0
CH <> NL ?
@BOX 9.0
SPACES(12)
6 => COUNT
WRITE NEXT LABEL FIELD
@BOX 10.0
POSITION /= 0 ?
@BOX 11.0
SPACES(12 + COUNT)
OUTCH("^")
NEWLINES(1)
1 => POSITION
@BOX 22.0
NEXTCHAR = 0 ?
@BOX 14.0
CLEAR STATEMENT BUFFER
@BOX 15.0
END
@BOX 1.1
;$IN SS
; $IN COUNT,POSITION
@BOX 3.1
#FTN13.1.1.1
@BOX 4.1
;SELECT.OUTPUT(MON.STR)
;NEWLINES(0)
;OUT.LINE.NO(CURLINPAG.G) :: TEN COLUMNS?
;SPACES(2)
; -1 => SS
;FOR COUNT <6 DO
   IF INLINE.G[1 +> SS] => CH = TAB.L THEN
      IF COUNT < 5 THEN
         SPACES(5-COUNT)
       ;4 => COUNT
      ELSE OUTCH(SPACE.L) FI
   ELSE OUTCH(CH) FI
OD
@BOX 23.1
; IF INLINE.G[1+>SS] => CH = 0
@BOX 5.1
;IF CH = TAB.L THEN OUTCH(SPACE.L)
              ELSE OUTCH(CH) FI
; IF POSITION < 0
@BOX 20.1
; 1+> COUNT
@BOX 6.1
;IF CH = SPACE.L OR CH = TAB.L
     OR CH = NL.L OR CH = NP.L
@BOX 7.1
;1 +> POSITION
@BOX 8.1
;IF CH /= NL.L
@BOX 9.1
;SPACES(12)
;FOR COUNT < 6 DO
   IF INLINE.G[1+>SS] => CH = TAB.L THEN
      IF COUNT < 5 THEN
         SPACES(5-COUNT)
         ;4 => COUNT
      ELSE OUTCH(SPACE.L) FI
   ELSE OUTCH(CH) FI
OD
@BOX 10.1
;IF POSITION /= 0 OR DETAILS = 0
@BOX 11.1
;SPACES(12 + COUNT)
;OUTCH('^)
;NEWLINES(1)
; 1 => POSITION
@BOX 22.1
;IF INLINE.G[1+SS] => CH = 0
@BOX 14.1
; 0 => INLINE.G[0]
@BOX 15.1
@END
@TITLE FTN13.1.1.1(1,6)
@COL 1S
@FLOW 1
@BOX 1.0
CALCULATE POSITION IN LINE
@BOX 1.1
;DETAILS => POSITION
;IF DETAILS <0 THEN
   ;0 - DETAILS => I
   ; -1 => SS
   ; WHILE 1 +> SS < I DO
      IF LINE.G[SS] => CH = MARK.HOL.L THEN
         0 => COUNT
         ;WHILE LINE.G[1+>SS] /= 0 DO 1+>COUNT OD
         ;(IF COUNT > 999 THEN 3
            ELSE (IF COUNT > 99 THEN 2
               ELSE (IF COUNT > 9 THEN 1 ELSE 0))) -> POSITION
      ELSE (IF CH = L.EQ.L OR CH = L.NE.L OR CH = L.LE.L
               OR CH = L.GE.L OR CH = L.LT.L OR CH = L.GT.L
                                             OR CH = L.OR.L
            THEN 3
            ELSE(IF CH = L.AND.L OR CH = L.NOT.L OR CH=L.EQV.L
               THEN 4
             ELSE(IF CH = L.NEQV.L OR CH= L.TRUE.L
                  THEN 5
              ELSE (IF CH = L.FALSE.L THEN 6
                  ELSE 0 )))) -> POSITION
        FI
   OD
FI
@END
@TITLE FTN13.1.2(1,11)
@COL 1S-2R-3R-4R-6R-7F
@FLOW 1-2-3-4-6-7
@BOX 1.0
PRINT MESSAGE
MESSAGE DATA
MESSAGE LENGTH LITERALS:13.1.2.1:
MESSAGE INDEX LITERALS :13.1.2.2:
DATAVEC OF MESSAGE INDICES :13.1.2.3:
MESSAGES 1 TO 50  :13.1.2.4:
MESSAGES 51 T0 100:13.1.2.5:
MESSAGES 101 TO 150:13.1.2.6:
MESSAGES 150 TO 200 :13.1.2.7:
@BOX 2.0
local procedure DING
@BOX 3.0
local procedure PRINT.NAME
@BOX 4.0
ADD 1 TO CLASS COUNT
PRINT CLASS MESSAGE
@BOX 6.0
PRINT FAULT MESSAGE
FROM TABLE
@BOX 7.0
END
@BOX 1.1
;PROC PRINT.MESSAGE(MESSAGE, DETAILS);
;$IN I,J,TEMP,K :: @@@ BCT 30-DEC-82
;$LO8 CH
;ADDR LOCAL.PROP LP
:: @@@ BCT 22-DEC-82 Start of new code
@BOX 2.1
:: @@@ BCT Start of new procedure
;PSPEC DING($IN)
;PROC DING (SZ)
;IF SZ+LINE.USED > MAX.LINE.POSITION THEN
     NEWLINES (1)
   ; SPACES (SPACES.UP)
   ; SPACES.UP => LINE.USED
FI
END
:: @@@ BCT End of new procedure
@BOX 3.1
;PSPEC PRINT.NAME(ADDR[$LO8])
;PROC PRINT.NAME(P)
:: @@@ BCT 31-DEC-82 Start of new code
:: ??? JM 19-JAN-83 Start of new code
;$IN I, J
;IF SIZE(P) => J + 1 => I < 1300
    THEN WHILE 1->J >= 0 AND P^[J] > 31 < 127 DO OD
 FI
;IF J >= 0 THEN NIL.STR => P ;0 => I FI
:: ??? JM 19-JAN-83 End of new code
;DING(I)
;CAPTION(P)
;I+>LINE.USED
:: @@@ BCT 31-DEC-82 End of new code
;OUT.CH(SPACE.L)
;END
@BOX 4.1
; 1 +> ERROR.CNT.G [CLASS]
; CAPTION (CLASS.MESSAGE.L [CLASS])
;IF PU.G /= 3 /= 2 THEN
    10 => LINE.USED
ELSE
   ;23 => LINE.USED
   ;CAPTION(%"in ")
   ;IF PU.G = 3 THEN CAPTION(%"FUNCTION ")
    ELSE CAPTION(%"SUBROUTINE ")
        ; 2 +> LINE.USED FI
   ; PRINT.NAME (NAME OF G.NAME OF G.CUR.PU^)
   ; CAPTION (%"- ")
 FI
; LINE.USED => SPACES.UP
:: @@@ BCT 22-DEC-82 End of new code
@BOX 6.1
;SIZE (MESSAGE) => J  ;0 => I
;WHILE I < J DO
   IF MESSAGE^[I] => CH = '@ THEN
      ;SPACES(1)
      ;IF DETAILS =< 0 THEN 6 => DETAILS FI
      ALTERNATIVE DETAILS&%F-1 FROM
;PRINT.NAME(NAME OF  L.NAME OF F.L.PROP.G^) :: ??? JM 29-DEC-82
;PRINT.NAME(NAME OF C.NAME OF FC.PROP.G^) :: ??? JM 29-DEC-82
;BEGIN
      ;DING (10) :: @@@ BCT 31-DEC-82
      ; 10 +> LINE.USED :: @@@ BCT 31-DEC-82
      ;OUTI(S.NAME OF F.S.PROP.G^,0)
      ;SPACES(1)
END
;PRINT.NAME(NAME OF G.NAME OF F.GPROPG^) :: ??? JM 29-DEC-82
;BEGIN
  ;LOC OF PROPS.T[AS[F.L.PROP.ADDR.G]] => LP
   ;PRINT.NAME(NAME OF L.NAME OF L.P^) :: ??? JM 29-DEC-82
;END
      ;SPACES(1)
      ;PRINT.NAME(F.B.G) :: @@@ BCT 31-DEC-82
:: @@@ BCT 31-DEC-82 Start of new code
;BEGIN
     ;DING (10)
     ; 10 +> LINE.USED
     ; OUTI(F.I.G,0)
     ;SPACES(1)
 END
      END
; DETAILS ->> 4 => DETAILS
;1+>I
   ELSE
; I => K
; WHILE 1+> K<J AND MESSAGE^[K] => CH /= SPACE.L /= '@
      DO OD
; DING (K-I)
; K-I +> LINE.USED
; CAPTION(PART(MESSAGE,I,K-1))
; K => I
   FI
:: @@@ BCT 30-DEC-82 End of new code
OD
;NEWLINES(1)
@BOX 7.1
END
@END
@TITLE FTN13.1.3(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
print lexical errors
@BOX 2.0
EXTRACT BITS
PRINT MESSAGE : 13.1.2:
CLEAR BITS
@BOX 3.0
end of lexical errors
@BOX 1.1
;BEGIN
@BOX 2.1
; IF LEX.FAULT.G /= 0 THEN
FOR I < 8 DO
   IF LEX.FAULT.G & (1 <<- I) /= 0 THEN
      ; FAULT.MESSAGE [FAULT.INDEX[I-1] - 1] ->> 5 => CLASS
      ;PRINT.MESSAGE(PART(^FAULT.MESSAGE,
                          FAULT.INDEX[I-1],
                          FAULT.INDEX[I]-2),
                    0)
   FI
OD
FI
;0  => LEX.FAULT.G :: @@@ BCT 22-DEC-82
@BOX 3.1
;END
@END
@TITLE FTN13.2(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
INFORM(MODE)
MODE SETTINGS
BITS 0-15 CONTROL LINE MONITORING
BIT 8=1 ALLOCATE STATIC VARIABLES ON STACK
BIT 9=1 PRINT LINE AND AR
BIT10=1 PRINT GLOBAL AND COMMON PROPS
BIT11=1 PRINT LOCAL PROPS
BIT12=-1 PRINT LABEL PROPS
BIT13=1 SWITH ON STATEMENT LISTING
BIT14=1 SWITCH OFF ARGUMENT TYPE CHECKING
BIT15=1 **COMMANDS INTERPRETED
BITS 16-31 CONTROL MONITORING AT END OF PU
INTERPRETED AS BITS 8-15
@BOX 2.0
SAVE MODE
@BOX 3.0
END
@BOX 1.1
;PROC INFORM(M,A,N)
@BOX 2.1
;M => INFORM.LINE.G
;N & %FFFF => DEBUG.LINE.G
;N ->> 16 => DEBUG.PU.G
;A => ANSI.BITS.G
@BOX 3.1
;END
@END
@TITLE FTN13.3(1,6)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
MONITOR(MODE)
MODE AS IN BITS 8-15 OF INFORM
@BOX 2.0
CALL APPROPRIATE OUT PROCS
:13.4: -> :13.9:
@BOX 3.0
END
@BOX 1.1
;PROC MONITOR(M)
@BOX 2.1
;IF M & %200 /= 0 THEN OUT.LI(); OUT.AR() FI
;IF M & %400 /= 0 THEN OUT.G();OUT.C() FI
;IF M & %800 /= 0 THEN OUT.L() FI
;IF M & %1000 /= 0 THEN OUT.S() FI
@BOX 3.1
;END
@END
@TITLE FTN13.4(1,6)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
OUT.G()
@BOX 2.0
PRINT GLOBAL PROPS
@BOX 3.0
END
@BOX 1.1
;PROC OUT.G
;ADDR GLOBAL.PROP GP
;LITERAL / ADDR GLOBAL.PROP NIL.GP =
;$IN I,J,Z
;ADDR [$LO8] V
@BOX 2.1
;NEWLINES(2)
;CAPTION(%"GLOBAL PROPS")
; -1 => I
;WHILE 1+> I < GLOBAL.HASH.Z.L DO
       ;G.HASH[I] => G.P
       ;WHILE G.P /= NIL.GP DO
               ;OUT.N(NAME OF G.NAME OF GP^) :: ??? JM 29-DEC-82
               ;CAPTION(%"G.KIND = ");OUT.I(G.KIND OF GP^,3)
               ;CAPTION(%"G.TL.NAME = ");OUT.16(G.TL.NAME OF GP^)
               ;IF G.ARG.SPEC.P OF GP^  => V /= NIL.STR THEN
                   ;CAPTION(%" G.ARG.SPEC =")
                   ;-1 => J;SIZE(V) => Z
                   ;WHILE 1+> J <Z DO OUT.B(V^[J])OD
               ;FI
                   ;G.NEXT.P OF GP ^ => GP
               ;OD
;OD
@BOX 3.1
;END
@END
@TITLE FTN13.5(1,10)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
OUT.C()
@BOX 2.0
PRINT COMMON.PROPS
@BOX 3.0
END
@BOX 1.1
;PROC OUT.C
;ADDR COMMON.PROP P
;LITERAL/ADDR COMMON.PROP NIL.CP=
;$IN I
@BOX 2.1
;NEWLINES(2)
;CAPTION(%"COMMON PROPS")
;-2=>I
;WHILE 1+>I < COMMON.HASH.Z.L DO
   ;IF I<0 THEN BLANK.COM.G=>P
   ELSE  C.HASH[I]=>P FI
  ;WHILE P /= NIL.CP DO
    ;OUT.N(NAME OF C.NAME OF P^) :: ??? JM 29-DEC-82
    ;OUT.A(BYTE(P))
     ;CAPTION(%"C.KIND = ");OUT.B(C.KIND OF P^)
    ;CAPTION(%"C.HEAD = ");OUT.HEX(BYTE(C.HEAD OF P^),8)
    ;CAPTION(%"C.TAIL = ");OUT.HEX(BYTE(C.TAIL OF P^),8)
    ;CAPTION(%"C.PREV = ");OUT.HEX(BYTE(C.PREV.P OF P^),8)
    ;CAPTION(%"C.SIZE = ");OUT.I(C.SIZE OF P^,0)
    ;CAPTION(%"C.AREA.NO = ");OUT.I(C.AREA.NO OF P^,0)
    ;C.NEXT.P OF P^ => P
  ;OD
;OD
@BOX 3.1
;END
@END
@TITLE FTN13.6(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
OUT.L()
@BOX 2.0
PRINT LOCAL PROPS
@BOX 3.0
END
@BOX 1.1
;PROC OUT.L
;ADDR LOCAL.PROP P
;LITERAL/ADDR LOCAL.PROP NIL.LP=
;$IN I,J,Z
;$IN [LOCAL.HASH.Z.L] ENTRY.COUNT :: ??? JM 28-DEC-82
;$IN ROW.NUMBER :: ??? JM 29-DEC-82
;ADDR [$IN] V
;LITERAL/ADDR [$LO8] NIL.STRING =
;ADDR [$LO8] X
@BOX 2.1
;NEWLINES(2)
;CAPTION(%"LOCAL PROPS")
;-1=>I
; 0=>ROW.NUMBER :: ??? JM 29-DEC-82
;WHILE 1+>I < LOCAL.HASH.Z.L DO
  ;0 => ENTRY.COUNT[I] :: ??? JM 28-DEC-82
  ;L.HASH[I] => P
  ;WHILE P /= NIL.LP DO
    ;OUT.N(NAME OF L.NAME OF P^) :: ??? JM 29-DEC-82
    ;OUT.A(BYTE(P))
    ;OUT.I(I,4) ;SPACES(2) ;1+>ENTRY.COUNT[I] :: ??? JM 28-DEC-82
        ;CAPTION(%"LLINK1 = ");OUT.HEX(BYTE(L.LINK.1 OF P^),8)
           ;CAPTION(%" LINK2 = ");OUT.HEX(BYTE(L.LINK.2 OF P^),8)
        ;CAPTION(%" L.TYPE=");OUT.I(L.TYPE OF P^,2);NEWLINES(1)
         ;CAPTION(%"L.SPECS=");OUT.16(L.SPECS OF P^)
         ;CAPTION(%" L.KIND=");OUT.I(L.KIND OF P^,0)
         ;CAPTION(%" L.LEN=");OUT.I(L.LEN OF P^,0)
         ;CAPTION(%" L.TL.NAME=");OUT.16(L.TL.NAME OF P^)
         ;IF L.KIND OF P^ = 2 THEN
               ;NEWLINES(1)
               ;L.ARR.SPEC.P OF P^ => V
               ;CAPTION(%"L.ARR.SPEC.P=");
               ;-1 => J ; SIZE(V) => Z
               ;WHILE 1+> J < Z DO OUT.16(V^[J]) OD
         ;FI
         ;IF [L.KIND OF P^ > 3 OR L.SPECS OF P^ & %800 /= 0] THEN
              CAPTION(%"$L L.ARG.SPEC = ")
            ; -1 => J ; SIZE(L.ARG.SPEC.P OF LALT OF P^=>X) => Z
            ; WHILE 1+>J < Z DO OUT.B(X^[J]) OD
            ; CAPTION(%" L.INTR.NO = ");OUT.B(L.INTR.NO OF L.ALT OF P^)
            ; CAPTION(%" L.CH.RES.NAME = ");OUT.16(L.CH.RES.NAME OF L.ALT OF P^)
            ; CAPTION(%" L.SPEC.TL.NAME = ");OUT.16(L.SPEC.TL.NAME OF L.ALT OF P
^)
          FI
         ;L.NEXT.P OF P^ => P
        ;CAPTION(%" L.NEXT.P=");OUTHEX(BYTE(P),8)
    ;OD
    ;IF ENTRY.COUNT[I] > ROW.NUMBER
        THEN ENTRY.COUNT[I] => ROW.NUMBER
     FI :: ??? JM 29-DEC-82
;OD
;NEWLINES(1)
;WHILE ROW.NUMBER > 0 DO
     FOR I < LOCAL.HASH.Z.L DO
         OUT.CH ((IF ENTRY.COUNT[I] >= ROW.NUMBER THEN '* ELSE " "))
     OD
     ;NEWLINES(1)
     ;1->ROW.NUMBER
OD :: ??? JM 29-DEC-82
@BOX 3.1
;END
@END
@TITLE FTN13.7(1,6)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
OUT.S
@BOX 2.0
PRINT STATEMENT LABEL PROPS
@BOX 3.0
END
@BOX 1.1
;PROC OUT.S
;ADDR LABEL.PROP P
;LITERAL/ADDR  LABEL.PROP NIL.SP =
;$IN I

@BOX 2.1
;NEWLINES(2)
;CAPTION(%"STATEMENT LABEL PROPS")
;-1 => I
;WHILE 1+>I <LABEL.HASH.Z.L DO
; S.HASH[I] => P
;WHILE P /= NIL.SP DO
       ;NEWLINES(2);OUT.I(S.NAME OF P^,8)
       ;CAPTION(%" S.KIND=");OUT.B(S.KIND OF P^)
       ;CAPTION(%" S.LEVEL=");OUT.I(S.LEVEL OF P^,0)
       ;CAPTION(%"S.BLOCK=");OUT.I(S.BLOCK OF P^,0)
       ;CAPTION(%"S.TL.NAME=");OUT.16(S.TL.NAME OF P^)
      ;S.NEXT.P OF P^=> P
;OD
;OD
@BOX 3.1
;END
@END
@TITLE FTN13.8(1,10)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
OUT.AR
@BOX 2.0
PRINT ANALYSIS RECORD
@BOX 3.0
END
@BOX 1.1
;PROC OUT.AR
;$IN I,J

@BOX 2.1
;NEWLINES(2)
;CAPTION(%"ANALYSIS RECORD STAT.AP.G ");OUT.16(STAT.AP.G)
;-8 => I
;WHILE 8+>I < STAT.AP.G+8 DO
      ;NEWLINES(1);OUT.B(I)
      ;-1 => J
       ;WHILE 1+>J < 8 DO
         ;SPACES(1);OUT.HEX(AS[I+J],8)
      ;OD
;OD
::;NEWLINES(1)
::;CAPTION(%" WORK STACK")
::;-8=>I
::;WHILE 8+>I < 32 DO
::   ;NEWLINES(1)
::   ;-1=>J
::   ;WHILE 1+>J < 8 DO
::      ;SPACES(1);OUTHEX(WS[I+J],8)
::   ;OD
::;OD
@BOX 3.1
;END
@END
@TITLE FTN13.9(1,6)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
OUT.LI
@BOX 2.0
OUTPUT ITEMISED LINE
@BOX 3.0
END
@BOX 1.1
;PROC OUT.LI
;$IN I,J
@BOX 2.1
; NEWLINES(2)
; CAPTION(%" INPUT LINE ")
;OUT.LINE.NO(CURLINPAG.G);NEWLINES(1)
; FOR I < 1461 DO
  IF INLINE.G[I] => J = 0, -> DONE
   ; IF J = NL.L THEN OUTCH(%7E) FI
  ; OUTCH(J)
  OD
;DONE :OUTCH(%7C)
;NEWLINES(1)
;CAPTION(%"ITEMISED LINE");OUT.LINE.NO(I.POS())
;-32 => I
;WHILE 32+>I <80 DO
      ;NEWLINES(1)
      ;-1 => J
      ;WHILE 1+>J < 32 DO
         ;OUT.B(LINE.G[I+J])
      ;OD
;OD
;NEWLINES(1)
@BOX 3.1
;END
@END
@TITLE FTN13.10(1,10)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
OUT.F
@BOX 2.0
OUTPUT FORMAT AREAS
@BOX 3.0
END
@BOX 1.1
;PROC OUT.F
;$IN I,J
@BOX 2.1
; NEWLINES(2)
; CAPTION(%" FORMAT TABLE ");OUT.I(FMT.TBL.SZ.G,5)
;-8 => I
;WHILE 8 +> I < FMT.TBL.SZ.G DO
     ; NEWLINES(1)
     ; -1 => J
     ; WHILE 1+>J < 8 DO
           SPACES(1) ; OUTHEX(FMT.TABLE[I+J],8)
     OD
OD
; NEWLINES(2)
; CAPTION(%" FORMAT STRINGS ")
;  -1 => I
; WHILE FMT.STRINGS[1+>I]  => J /= 0 DO
     OUTCH(J) OD
;OUTCH(%7E);NEWLINES(1)
@BOX 3.1
END
@END
@TITLE FTN13.20(1,10)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
COMMON OUTPUT PROCS
@BOX 2.0
OUT.N(NAME) :PRINT NAME
OUT.B(BYTE) :PRINT HEX BYTE
OUT.A(ADDR) :PRINT ADDRESS
OUT.16(VAL) :PRINT 16 BIT HEX VALUE
@BOX 3.0
END
@BOX 1.1
@BOX 2.1
;PROC OUT.N(N)
;NEWLINES(2);CAPTION(N);NEWLINES(1)
;END
;PROC OUT.B(V)
;PSPEC OUT.H($IN)
;PROC OUT.H(H)
;IF H =< 9 THEN
    ;'0 +> H
;ELSE
      ;'A - 10+>H
;FI
;OUT.CH(H)
;END
;OUT.H(V->>4 & %F);OUT.H(V & %F)
;END
;PROC OUT.A(AD)
;CAPTION(%" AT ")
;OUTHEX(AD,8);SPACES(2)
;END
;PROC OUT.16(V)
;OUT.B(V ->> 8 & %FF);OUT.B(V & %FF)
;END
@BOX 3.1
@END

