@X @~
~V7 56 2 -5
~D10
~H                    MUSS
~
~
~D10
~H             FTN031
~D10
~MMANCHESTER UNIVERSITY  -  CONFIDENTIAL~
~
~
                                                         ISSUE 10~
~V9 -1
~P
~V9 1
~YFTN031
~S1~M~OFORTRAN 77 COMPILER IMPLEMENTATION DESCRIPTION
~S1~M~OSection 3~
~S1~OSection 3. Lexical Analysis
~S1~O1.1 ~OGeneral Description
~BThis section of the compiler handles the input of the source program
text, one FORTRAN statement at a time. The program text is input to
a line buffer (INLINE.G) where it is kept for later listing by the error
handling section. The raw input line is partially itemised by the procedure
LEXICAL which removes all blanks and tabs up to column 72, handles
comments and continuation lines, and itemises logical operators and
constants between periods and itemises character string literals and
Holleriths. The itemised line is held in the itemised line buffer
(LINE.G).
~BThe Lexical Analyser reads the label field of the next statement
to be processed, after reading one statement. This enables all the
continuation lines to be detected and also enables the next label
to be available for more efficient code generation.
~S1~O1.2  Non Standard Features
~BThe Fortran character set described in the standard has been
extended by allowing the use of lower case letters, the tab character and the
newpage character.
Lower case letters are used as alternatives to upper case letters.
The only significant use of the tab
character is before column 6, when it causes a tabbing
to that column.~
~BThe use of Holleriths in DATA and CALL statements is implemented in
extension to the described standard. It is implemented in the manner
specified in appendix C of the Fortran 77 standard, which
describes this language extension.
~BA compiler option (which is activated by the second parameter to
the compiler call) is available for certain comments to contain MUSS
commands to be interpreted at compile time as they are found. These
commands have an asterisk in columns one and two and start with an
alphabetic character in column three. Any other format is assumed to be
a comment. If the option is not activated, these lines are taken as comments
in the usual way.
~BComments may occur in any position in a Fortran program, which
is an extension to the standard that prohibits comments after the
last end of the last program unit.
~S1~O2.  Interfaces
~S1~O2.1  Section Interfaces Used~
~
   Section  1:   (Configuration Section)~
   Section 13:   (Fault Monitoring)~
~S1~O2.2  Section Interface~
~
Exported Scalars:~
   LABEL.FAULTY.G~
   ASSIGN.FL.G~
   OBEY.PPC.G~
   CUR.LIN.PAG.G~
   NEXT.ST.LABEL.G~
   CURRENT.LABEL.G~
~
Exported Vectors:~
   LINE.G~
   INLINE.G~
~
Exported Procedures:~
   LEXICAL~
~S1~O3.  Implementation
~S1~O3.1  Outline of operation
~BLexical Analysis is done by one procedure (LEXICAL) which contains
several sub-procedures within it. The procedure READNEXTLB is used
to process the label field and continuation fields of each line,
any comments being ignored. Any MUSS commands to be interpreted are
handled by this procedure too. The label field read is stored in
INLABEL.G in text form for future transfer to INLINE.G as needed. The
numerical value of the label found is returned by the procedure.
A negative label value indicates a continuation line.
~BThe procedure INCARD obtains the characters for the FORTRAN statement
one at a time, calling READNEXTLB as necessary to read in more
continuation lines, and the INLINE.G buffer is updated.
~BThe chart ITEMISE LOGICAL NAME is used whenever a period
is detected in input, to attempt to itemise any logical operator or
constant found.
The name is matched against a datavec of logical 32 constants
containing the valid logical names.~
~BThe chart ITEMISE CHARACTER STRING is used to itemise a
character string literal whenever a quote mark is detected in the input.
~BThe chart ITEMISE HOLLERITH is used to itemise any Hollerith
in the input source.
~BSpaces and tabs in a statement are ignored.
~BThe LEXICAL procedure reads the first label field of the first
input line when it is first called.
~BA flag is set when the EOT (marking the end of file) is detected, and
the *END directive is generated when LEXICAL is called again.
By noting the characters '(),=' it is possible to determine
if the statement may be an assignment. If a ',' is encountered
outside parenthesis then the statement is not an assignment. If
an '=' is encountered then the statement may be an assignment.
The flag ASSIGN.FL.G is set accordingly.
~BTo simplify the task of recognising expressions
the strings '**' and '//' are replaced by single
characters in the itemised line. Unfortunately
the replacement of '//' by a single requires special
syntax action in COMMON and FORMAT statements.~
~S1~O3.2  Data Structures
~BThe output of the lexical section are the values of the current and next
statement labels, the text of the input lines forming the statement in
INLINE and the itemised form of the statement in LINE.~
~T% 16
~
INLABEL.G
~IA vector of characters containing the text of the next label field.~
~
SS
~IAn index to LINE.~
~
BITFLAGS.G
~IA bit list used for the invalid label flag and the end of file flag.~
~
LEX.CH.L
~IA datavec containing the lexical actions for every character.~
~
ILSS.G
~IAn index to INLABEL.G.~
~
CONT.CNT.G
~IA count of continuation lines.~
~
IN.COL.G
~IThe column number of the first non-blank character of a
statement.~
~
INLINE.G~IVector of characters containing the input line text of the statement.~
~
LINE.G
~IA vector of characters containing the itemised line. For an itemised
logical name a special character is stored. For a character string or
a Hollerith constant it contains an initial warning character followed
by the characters in the string or constant followed by a zero
terminator byte.~
~
NEXT.ST.LABEL.G~IInteger value of next statement label.~
~
CURRENT.LABEL.G~IInteger value of current statement label.~
~
LABEL.FAULTY.G~ISet non-zero if statement label is faulty.~
~
CUR.LIN.PAGE.G~ILine and page of current statement.~
~
ASSIGN.FL.G~IIf non-zero then the current statement is possibly an
assignment or statement function statement. If zero statement cannot be
one of these statements.~
~Y
~V9 -1
~P
~D15
~HFLOWCHARTS
~
~
~H                FTN031
~V9 -1
~F
@TITLE FTN03(1,11)
@COL 1S-2R-5R-6R-7R-9F
@FLOW 1-2-5-6-7-9
@BOX 1.0

23-MAR-83 (BCT) Bug fix for validation suite+ANSYS
15-MAR-83 (BCT) Code freeze, first release
28-FEB-83 (BCT) Tape sent to Manchester
22-DEC-82 (BCT) New release of this section
LEXICAL ANALYSIS SECTION
@BOX 2.0
[IMPORTS FTN03/1]
MODULE HEADING
@BOX 5.0
SCALAR DECLARATIONS
@BOX 6.0
VECTOR DECLARATIONS
@BOX 7.0
PROCEDURES IN MODULE
   FTN03.1 : LEXICAL
@BOX 9.0
END
@BOX 2.1
#FTN03/1
;MODULE (LEXICAL,LINE.G,NEXT.ST.LABEL.G,CURRENT.LABEL.G,
        LABEL.FAULTY.G,ASSIGN.FL.G,CUR.LIN.PAG.G,
        INLINE.G);
@BOX 5.1
; *GLOBAL 2
;$LO8 LABEL.FAULTY.G,ASSIGN.FL.G
;$IN32 CUR.LIN.PAG.G,NEXT.ST.LABEL.G,CURRENT.LABEL.G
;$IN32 NEXT.LIN.PAG.G
;$LO8  BIT.FLAGS.G
;$IN ILSS.G,CONT.CNT.G,IN.COL.G
@BOX 6.1
;$LO8[LINE.SZ.L]LINE.G
;$LO8[75] INLABEL.G
; $LO8[INLINE.SZ.L] INLINE.G
; *GLOBAL 0
@BOX 7.1
; P.SPEC LEXICAL()
#FTN03.1
@BOX 9.1
;*END
@END
@TITLE FTN03/1(1,11)
@COL 1S-3R-4R-5R-6R-7F
@FLOW 1-3-4-5-6-7
@BOX 1.0
LEXICAL SECTION IMPORTS
@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 3.1
;IMPORT LITERAL $LO8 NL.L,NP.L,EOF.L,SPACE.L,TAB.L,
        INLINE.SZ.L,LINE.SZ.L,MARK.HOL.L,MARK.CH.L,
        L.EQ.L,L.NE.L,L.LT.L,L.LE.L,L.GE.L,L.GT.L,L.NOT.L,
        L.AND.L,L.OR.L,L.EQV.L,L.NEQV.L,
        L.TRUE.L,L.FALSE.L,EXPON.CH.L,CONCAT.CH.L,ILLEGAL.CH.L
; IMPORT LITERAL MAX.ERROR.L,LEX.CH.Z.L,ST.CH.Z.L
; IMPORT LITERAL $LO32 CLI.BIT.L
@BOX 4.1
; $LO32 INFORM.LINE.G
; $IN MON.STR
@BOX 5.1
;$LO8[LEX.CH.Z.L]LEX.CH.L
;$LO8[ST.CH.Z.L] ST.CH  :: @@@ BCT 22-DEC-82
@BOX 6.1
;P.SPEC FAULT($IN,$IN)
;L.SPEC PPC.CMD()
;L.SPEC SELECT.OUTPUT($IN)
;P.SPEC GET.INCH()/$IN
;L.SPEC IN.BACKSPACE($IN)
;P.SPEC GET.NEXT.CH()/$IN
;L.SPEC I.POS()/$IN32
@END
@TITLE FTN03.1(1,11)
@COL 1S-3R-30T-31R-35T-36R-32T-4R-37R-38F
@COL 11R-33R
@ROW 4-33
@FLOW 1-3-30N-31-35N-36-32N-4-37-38
@FLOW 30Y-32
@FLOW 35Y-32Y-33-38
@BOX 1.0
LEXICAL ANALYSIS
@BOX 3.0
DECLARATIONS
@BOX 30.0
NOT FIRST TIME?
@BOX 31.0
INITIALISE BITFLAGS
READ FIRST LABEL:3.2:
@BOX 35.0
INITIAL LINE?
@BOX 36.0
 FAULT 1
'INITIAL CARD OF
FIRST STATEMENT MISSING'
@BOX 32.0
EOF ?
@BOX 33.0
PUT "*END" IN ITEMISED LINE
@BOX 4.0
INCREMENT LABEL
INIT ITEMISED LINE PTR
INIT LAST "." PTR
INIT LEVEL
INIT ASSIGN FLAG
@BOX 5.0
PUT CH IN ITEMISED LINE
SWITCH ON CHAR
@BOX 11.0
ROUTINES USED IN LEXICAL ANAL
READ NEXTLB :3.2:
INCARD :3.3:
READINT:3.4:
@BOX 37.0
ITEMISE LINE:3.1:
@BOX 38.0
END
@BOX 1.1
;PROC LEXICAL
@BOX 3.1
;P.SPEC READNEXTLB()/$IN32
;P.SPEC INCARD()/$LO8
;P.SPEC READINT()/$IN
;$IN SS,INSS
;$IN LASTDOT,INP.CNT
;$LO8 CH,CH2,READING.HOL
; $IN LEVEL
;0 => READING.HOL
@BOX 30.1
;IF NEXTSTLABEL.G >= 0
@BOX 31.1
;0=> BITFLAGS.G
;READNEXTLB() => NEXTSTLABEL.G
;I.POS() => NEXTLINPAG.G
@BOX 35.1
;IF NEXTSTLABEL.G >= 0
@BOX 36.1
;0 => NEXTSTLABEL.G
;FAULT(1,0)
@BOX 32.1
;IF BITFLAGS.G & 1 /= 0
@BOX 4.1
;BITFLAGS.G & 2  => LABELFAULTY.G
;%FD &> BITFLAGS.G
;NEXTLINPAG.G => CUR.LINPAG.G
;FOR INSS < ILSS.G+1 DO
      INLABEL.G[INSS] => INLINE.G[INSS] OD
; 1->INSS
;IN.COL.G => INPCNT
;NEXTSTLABEL.G => CURRENTLABEL.G
;-6 => LASTDOT
;0 => SS  => LEVEL => ASSIGN.FL.G
@BOX 37.1
#FTN03.1.1
@BOX 38.1
END
@BOX 11.1
#FTN03.2
#FTN03.3
#FTN03.4
@BOX 33.1
;'* => LINE.G[0]
;'E => LINE.G[1]
;'N => LINE.G[2]
;'D => LINE.G[3]
;NL.L => LINE.G[4]
@END
@TITLE FTN03.1.1(1,11)
@COL 1S-20T-21R-5R-2C-3R-8C-9R-17C-10R-40C-41T-42R
@COL 6C-22R-52N-53N-12C-13R-15C-4T-16R-7C-23R-24T-14F
@COL 43C-44R-45C-46R-47C-48R-54N-49C-50R-58C-59R-25C-26R
@ROW 21-22
@ROW 8-12-49
@ROW 40-7-25
@ROW 53-54
@FLOW 1-20N-21-5
@FLOW 6-20
@FLOW 8-9-17-10-20Y-22-5
@FLOW 12-13-24
@FLOW 15-4QUOTE-16-24
@FLOW 4PRIME-10
@FLOW 7-23-24N-14
@FLOW 24Y-5
@FLOW 2-3-5
@FLOW 41Y-10
@FLOW 25-26-14
@FLOW 40-41N-42-20
@FLOW 43-44-52-53-10
@FLOW 45-46-53
@FLOW 47-48-54-53
@FLOW 49-50-53
@FLOW 58-59-53
@BOX 1.0
ITEMISE LINE
@BOX 2.0
LOWER CASE
LETTERS
@BOX 3.0
CONVERT TO UPPER
CASE
@BOX 40.0
* /
@BOX 41.0
LAST CHAR IN LINE /= CH ?
@BOX 42.0
REPLACE BY NEW SYMBOL
@BOX 5.0
PUT CH IN ITEMISED LINE
SWITCH ON CHAR
@BOX 6.0
SPACE
TAB
@BOX 7.0
NL
NP
@BOX 8.0
.
@BOX 9.0
TRY TO ITEMISE LOGICAL NAME:3.1.1.1:
@BOX 10.0
INCR ITEMISED LINE PTR
@BOX 12.0
H
@BOX 13.0
TRY TO ITEMISE HOLLERITH :3.1.1.2:
@BOX 14.0
END
@BOX 15.0
'
@BOX 4.0
IS IT A QUOTE OR A PRIME?
@BOX 16.0
ITEMISE CHARACTER STRING:3.1.1.3:
@BOX 17.0
ALL
OTHER
CHARS
@BOX 20.0
INCR COL POS
PAST COL 72?
@BOX 21.0
GET.INCH()=>CH => INLINE
@BOX 22.0
SKIP TO NL OR NP
@BOX 23.0
REMOVE CH FROM INLINE
INBACKSPACE(1)
INCARD() => CH
@BOX 24.0
IF CH /= NL?
@BOX 25.0
EOF ?
@BOX 26.0
SET EOF FLAG
PUT NL IN BUFFERS
@BOX 43.0
(
@BOX 44.0
INC LEVEL
@BOX 45.0
)
@BOX 46.0
DEC LEVEL
@BOX 47.0
=
@BOX 48.0
SET FLAG
IF LEVEL ZERO
@BOX 49.0
,
@BOX 50.0
CLEAR FLAG
IF LEVEL ZERO
@BOX 58.0
NON-FORTRAN
CHAR
@BOX 59.0
PUT WARNING CHAR
IN ITEMISED LINE
@BOX 2.1
;L.CASE:
@BOX 3.1
;CH - 'a + 'A => CH
@BOX 20.1
;IF 1 +> INPCNT > 72
@BOX 21.1
;GET.INCH() => CH => INLINE.G[1+>INSS]
@BOX 5.1
;CH => LINE.G[SS]
;SWITCH LEX.CH.L[CH]\
     SKIP,ILLEGAL,SPACE.TAB,
     DOT,NL.NP,STAR.SLASH,
     AHOLL,QUOTE,EOF,LEFT,
     RIGHT,EQUAL,COMMA,L.CASE
@BOX 6.1
;SPACE.TAB:
@BOX 8.1
;DOT:
@BOX 9.1
#FTN03.1.1.1
@BOX 17.1
;SKIP:
@BOX 10.1
;1+>SS
@BOX 7.1
;NL.NP:
@BOX 23.1
;1->INSS
;IN.BACKSPACE(1)
; INCARD() => CH
@BOX 24.1
;IF CH /= NL.L
@BOX 14.1
;0 => INLINE.G[1+>INSS]
@BOX 40.1
; STAR.SLASH:
@BOX 41.1
; IF SS < 1 OR LINE.G[SS-1] /= CH
@BOX 42.1
; (IF CH = '* THEN EXPON.CH.L
           ELSE CONCAT.CH.L)
      => LINE.G[SS-1]
@BOX 22.1
;WHILE GET.INCH() /= NL.L /= NP.L DO OD
;NL.L => CH
; 1 +> INSS
@BOX 12.1
;AHOLL:
@BOX 13.1
#FTN03.1.1.2
@BOX 15.1
;QUOTE:
@BOX 4.1
:: @@@ BCT 22-DEC-82
;IF SS > 0 AND [ [ST.CH[LINE.G[SS-1]=>CH] < %24
    OR CH = ')] AND LEVEL=1]
@BOX 16.1
#FTN03.1.1.3
@BOX 25.1
;EOF:
@BOX 26.1
;1!>BITFLAGS.G
;NL.L => LINE.G[SS] => INLINE.G[INSS]
@BOX 43.1
;LEFT:
@BOX 44.1
; 1+> LEVEL
@BOX 45.1
; RIGHT:
@BOX 46.1
; 1-> LEVEL
@BOX 47.1
; EQUAL:
@BOX 48.1
; IF LEVEL = 0 THEN
     1 => ASSIGN.FL.G FI
@BOX 49.1
; COMMA:
@BOX 50.1
; IF LEVEL = 0 THEN
     0 => ASSIGN.FL.G FI
@BOX 58.1
;ILLEGAL:
@BOX 59.1
;ILLEGAL.CH.L => LINE.G[SS]
@END
@TITLE FTN03.1.1.1(1,6)
@COL 2S-3R-4T-5R-6R-7T-8T-9R-10F
@COL 11R
@ROW 8-11
@FLOW 2-3-4NO-5-6-7NO-8NO-9-10
@FLOW 4YES-9
@FLOW 8YES-7YES-11-10
@BOX 2.0
ITEMISE LOGICAL NAME
@BOX 3.0
LIST OF NAMES TO
BE ITEMISED
@BOX 4.0
IS NAME IN ITEMISED LINE
<2 OR >5 CHARS
@BOX 5.0
SELECT NAME FROM
ITEMISED LINE
@BOX 6.0
INIT PTR TO LIST OF NAMES
@BOX 7.0
IS NEXT NAME FROM LIST = NAME?
@BOX 8.0
INCR PTR
@BOX 9.0
SET LASTDOT PTR
@BOX 11.0
PLANT IDENTIFIER IN
ITEMISED LINE
RESET LASTDOT PTR
@BOX 10.0
END
@BOX 2.1
;$IN LENGTH
;$LO32 NAME
;$IN ITEM
@BOX 3.1
;DATAVEC ITEM.LIST($LO32)
     "EQ"
     "NE"
     "LT"
     "LE"
     "GE"
     "GT"
     "OR"
    "NOT"
    "AND"
    "EQV"
   "NEQV"
   "TRUE"
   "FALS"
END
;DATAVEC ITEM.ID($LO8)
L.EQ.L L.NE.L L.LT.L L.LE.L
L.GE.L L.GT.L L.OR.L L.NOT.L
L.AND.L L.EQV.L L.NEQV.L L.TRUE.L L.FALSE.L
END
@BOX 4.1
;IF SS-LASTDOT => LENGTH < 2 OR LENGTH > 5
@BOX 5.1
;0=>NAME
;IF LENGTH=5 THEN 4 => ITEM
   ELSE LENGTH => ITEM FI
;FOR ITEM DO
     NAME <<- 8 ! LINE.G[LASTDOT]=>NAME
     ;1+>LASTDOT
OD
@BOX 6.1
;(IF LENGTH > 2 THEN (IF LENGTH > 3
           THEN (IF LENGTH = 5 THEN 12 ELSE 10)
                       ELSE 7) ELSE 0) => ITEM
@BOX 7.1
;IF ITEM.LIST[ITEM] = NAME AND [LENGTH /= 5 OR
                                LINE.G[SS-1] = 'E]
@BOX 8.1
;IF 1+>ITEM =< 12
@BOX 9.1
;SS+1 => LASTDOT
@BOX 11.1
;ITEM.ID[ITEM] => LINE.G[SS-LENGTH-1=>SS]
;-6 => LASTDOT
@BOX 10.1
@END
@TITLE FTN03.1.1.2(1,11)
@COL 20R
@COL 2S-21R-4T-5T-22T-6T-7R-3T-8R-10T-11T-16R-17R-14R-15F
@COL 12R
@ROW 16-12
@ROW 20-8
@FLOW 2-21-4NO-5NO-22NO-6NO-7-3N-8-10NO-11NO-16-10YES-17-14-15
@FLOW 5YES-4YES-20-14
@FLOW 3YES-20
@FLOW 6YES-20
@FLOW 11YES-12-17
@FLOW 22YES-20
@BOX 2.0
ITEMISEHOLL
@BOX 21.0
SAVE LINE PTR
@BOX 4.0
START OF LINE?
@BOX 5.0
DECR LINEPTR
IS NEXT CH A DIGIT?
@BOX 22.0
NO DIGITS?
@BOX 6.0
IS PRECEDING CH NOT AN OPERATOR?
@BOX 7.0
READ HOLL LENGTH:3.4:
@BOX 3.0
ZERO LENGTH?
@BOX 8.0
STORE IN ITEMISED LINE
HOLL WARNING CH
NOTE READING HOLL
@BOX 10.0
ALL CHARS COPIED?
@BOX 11.0
IS NEXT CH:3.3: A NL?
@BOX 16.0
COPY CH TO ITEMISED LINE
@BOX 14.0
RESET LINEPTR
INCREMENT LINEPTR
@BOX 15.0
END
@BOX 17.0
STORE NULL BYTE IN ITEMISED LINE
CLEAR READING HOLL
@BOX 12.0
FAULT 4
'INCOMPLETE HOLLERITH'
@BOX 20.0
READ NEXTCH
@BOX 2.1
;$IN16 TSS,CNT,XSS
@BOX 21.1
;SS => TSS
@BOX 4.1
;IF SS = 0
@BOX 5.1
;IF LINE.G[1->SS] => CH >= '0  =< '9
@BOX 22.1
;IF SS+1 = TSS
@BOX 6.1
;IF ST.CH[CH] < %60
@BOX 7.1
;SS+1=>XSS
;READINT() => CNT
@BOX 3.1
;IF CNT =< 0
@BOX 8.1
;MARK.HOL.L => LINE.G[XSS=>TSS]
;1+>TSS
;1 => READING.HOL
@BOX 10.1
; INCARD() => CH
;IF 1->CNT < 0
@BOX 11.1
;IF CH = NL.L
@BOX 16.1
;CH => LINE.G[TSS]
;1+>TSS
@BOX 17.1
;0 => LINE.G[TSS]
;0 => READING.HOL
@BOX 14.1
;TSS+1 => SS
;IF CH = NL.L THEN
    NL.L => LINE.G[SS]
FI
@BOX 15.1
@BOX 12.1
;FAULT(4,0)
@BOX 20.1
; INCARD() => CH
@END
@TITLE FTN03.1.1.3(1,6)
@COL 2S-3R-4T-5T-6R-7R-10R-11F
@COL 12R
@ROW 5-12
@FLOW 2-3-4N-5N-6-4Y-12-7
@FLOW 5Y-7-10-11
@BOX 2.0
CHARACTER STRING
@BOX 3.0
IN LINE
STORE STRING CH
SET READING HOLL FLAG
@BOX 4.0
NEXTCH => CH = NL?
@BOX 5.0
CH = QUOTE AND NEXTCH => CH /= QUOTE ?
@BOX 6.0
COPY CH TO ITEMISED LINE
@BOX 7.0
STORE NULL BYTE IN ITEMISED LINE
INCREMENT ITEMISED LINE PTR
@BOX 10.0
RESET READING HOLL FLAG
@BOX 11.0
END
@BOX 12.0
FAULT 5
'QUOTE MARKING THE END OF
CHARACTER STRING MISSING'
@BOX 2.1
@BOX 3.1
;MARK.CH.L => LINE.G[SS]
;1 => READING.HOL
@BOX 4.1
;IF INCARD() => CH = NL.L
@BOX 5.1
;IF CH = '' AND INCARD() => CH /= ''
@BOX 6.1
;CH => LINE.G[1+>SS]
@BOX 12.1
;FAULT(5,0)
@BOX 7.1
;0 => LINE.G[1+>SS]
; 1+> SS
;IF CH = NL.L THEN NL.L => LINE.G[SS] FI
@BOX 10.1
;0 => READING.HOL
@BOX 11.1
@END
@TITLE FTN03.2(1,11)
@COL 2S-3R-4T-40R-5T-6T-7R-8C-9T-10R-30T-41R-35T-36T-18R-19C
@COL 25T-26R-27C-11T-12T-13T-14R-15T-29T-16R-17T-20T-21R-22T-23R-24F
@FLOW 2-3-4N-40-5Y-40-5N-6Y-4Y-11Y-9Y-40
@FLOW 6N-7-8
@FLOW 9N-10-4
@FLOW 11N-12Y-25Y-4
@FLOW 25N-26-27
@FLOW 12N-13Y-7
@FLOW 13N-14-15Y-12
@FLOW 15N-29N-16-17Y-30N-41-35N-36N-18-19
@FLOW 17N-20N-21-22N-23-24
@FLOW 20Y-22Y-24
@FLOW 29Y-12
@FLOW 30Y-18
@FLOW 35Y-4
@FLOW 36Y-7
@BOX 2.0
PROC READNEXTLB
OUTPUT -1 CONT LINE
        0 INIT LINE
       >0 LABELLED LINE
@BOX 3.0
INIT VARS
@BOX 4.0
GET.INCH() => CH
IS CH <> "C"
@BOX 40
GET.INCH() => CH
@BOX 5.0
STILL IN COMMENT?
@BOX 6.0
MORE CARDS
@BOX 7.0
SET EOF FLAG
@BOX 8.0
RESULT
 = LABEL
@BOX 9.0
COMMENT?
@BOX 10.0
INBACKSPACE(2)
OBEY MUSS COMMAND
@BOX 30.0
GET.INCH() => CH
LABEL FIELD NOT BLANKS?
@BOX 41.0
SKIP ANY SPACES
:3.2.2:
@BOX 35.0
BLANK CARD?
@BOX 36.0
EOF ?
@BOX 18.0
INBACKSPACE(1)
SET COUNT OF
CONTINUATIONS = 1
@BOX 19.0
RESULT
 = LABEL
@BOX 25.0
BLANK CARD?
@BOX 26.0
INBACKSPACE(1)
@BOX 27.0
RESULT
 = LABEL
@BOX 11.0
IS CH = "*"
@BOX 12.0
CH = NL OR NP?
@BOX 13.0
 CH = EOF?
@BOX 14.0
LABEL:3.1.1:
@BOX 15.0
INCR COLUMN
BEFORE CONT. COL.?
@BOX 29.0
CH = EOF,NL,NP ?
@BOX 16.0
CH => INLABEL
INCREMENT COLUMN
@BOX 17.0
INITIAL CARD?
@BOX 20.0
COLS. 1-5 BLANK?
@BOX 21.0
WARNING 2
'COLUMNS 1-5 OF A CONTINUATION
CARD SHOULD BE BLANK'
@BOX 22.0
INCR. CONT. COUNT
< 19 CONTS.?
@BOX 23.0
WARNING 3
'MORE THAN 19
CONTINUATION CARDS'
@BOX 24.0
RESULT = -1
@BOX 2.1
;PROC READNEXTLB
@BOX 3.1
;$LO8 CH
;$IN32 LAB
@BOX 4.1
;0 => LAB
;0 => IN.COL.G
;-1 => ILSS.G
;IF GET.INCH() => CH /= 'C
@BOX 40.1
; GET.INCH() => CH
@BOX 5.1
;IF CH /= NL.L /= NP.L /= EOF.L
@BOX 6.1
;IF CH /= EOF.L
@BOX 7.1
;1!>BITFLAGS.G
@BOX 8.1
;LAB =>
READNEXTLB
EXIT
@BOX 9.1
;IF INFORM.LINE.G & CLI.BIT.L = 0
  OR GET.INCH() => CH /= '*
  OR [GET.NEXT.CH() => CH < 'A OR CH > 'Z]
  AND [CH <'a OR CH > 'z]
@BOX 10.1
;INBACKSPACE(2)
;SELECT.OUTPUT(MON.STR)
;PPC.CMD()
@BOX 30.1
;GET.INCH() => CH
;IF LAB > 0 OR BITFLAGS.G & 2 /= 0
@BOX 41.1
#FTN03.2.1
@BOX 35.1
;IF CH = NL.L OR CH = NP.L
@BOX 36.1
;IF CH = EOF.L
@BOX 18.1
;IN.BACKSPACE(1)
;0 => CONT.CNT.G
@BOX 19.1
;LAB =>
READNEXTLB
EXIT
@BOX 25.1
;IF LAB = 0 AND BITFLAGS.G & 2 = 0
@BOX 26.1
;IN.BACKSPACE(1)
@BOX 27.1
;LAB =>
READNEXTLB
EXIT
@BOX 11.1
;IF CH = '*
@BOX 12.1
;IF CH = NL.L OR CH = NP.L
@BOX 13.1
;IF CH = EOF.L
@BOX 14.1
#FTN03.2.2
@BOX 15.1
;IF 1+>IN.COL.G < 5
@BOX 29.1
;IF CH = EOF.L OR CH = NL.L OR CH = NP.L
@BOX 16.1
;CH => INLABEL.G[1+>ILSS.G]
; 1+> IN.COL.G
@BOX 17.1
;IF CH = SPACE.L  OR CH = TAB.L  OR CH = '0
@BOX 20.1
;IF LAB = 0 AND BITFLAGS.G & 2 = 0
@BOX 21.1
;FAULT(%102,0)
@BOX 22.1
;-1 => READ.NEXT.LB
;IF 1+>CONT.CNT.G =< 19
@BOX 23.1
;0 => READ.NEXT.LB
;FAULT(%103,0)
@BOX 24.1
END
@END
@TITLE FTN03.2.1(1,6)
@COL 1S-31T-32T-33R-34R-61F
@FLOW 1-31N-32N-33-31Y-34-61
@FLOW 32Y-61
@BOX 1.0
SKIP ANY SPACES
@BOX 31.0
PAST COL 72?
@BOX 32.0
IS CH NOT SPACE OR TAB?
@BOX 33.0
CH => INLABEL
INCREMENT COLUMN
GET.INCH()=>CH
@BOX 34.0
SKIP TO EOF,NP,NL
@BOX 61.0
END
@BOX 31.1
; IF IN.COL.G > 71
@BOX 32.1
; IF CH /= SPACE.L /= TAB.L
@BOX 33.1
; CH => INLABEL.G[1+>ILSS.G]
; GET.INCH() => CH
; 1 +> IN.COL.G
@BOX 34.1
; WHILE CH /= NL.L /= NP.L /= EOF.L DO
     GET.INCH() => CH OD
@END
@TITLE FTN03.2.2(1,11)
@COL 8R
@COL 2S-3R-4T-13N-6T-7T-9R-10R-11F
@COL 5R
@ROW 13-5
@ROW 8-9
@FLOW 2-3-4N-13-6N-7N-9-10-11
@FLOW 4Y-5-10
@FLOW 7Y-8-10
@FLOW 6Y-10
@BOX 2.0
LABEL
@BOX 3.0
CH => INLABEL
@BOX 4.0
CH = TAB?
@BOX 5.0
TAB TO COLUMN
@BOX 6.0
CH = SPACE?
@BOX 7.0
CH = DIGIT?
@BOX 8.0
FORM LABEL
@BOX 9.0
SET FAULTY LABEL FLAG
@BOX 10.0
GET.INCH => CH
@BOX 11.0
END
@BOX 2.1
@BOX 3.1
;CH => INLABEL.G[1+>ILSS.G]
@BOX 4.1
;IF CH = TAB.L
@BOX 5.1
;5 => IN.COL.G
@BOX 6.1
;IF CH = SPACE.L
@BOX 7.1
;IF CH >= '0 =< '9
@BOX 8.1
;LAB*10 + (CH-'0) => LAB
@BOX 9.1
;2!>BITFLAGS.G
@BOX 10.1
;GET.INCH() => CH  ::jae 3/25
@BOX 11.1
@END

@TITLE FTN03.3(1,6)
@COL 2S-3N-16R-10T-4T-20T-22R-11T-12T-13R-15T-5T-6F
@COL 7N-14R-8T-9C
@ROW 3-7
@ROW 10-8
@FLOW 2-10NO-4NO-20NO-22-11NO-12NO-13-14-8-5NO-6
@FLOW 4YES-8NO-9
@FLOW 20YES-11
@FLOW 5YES(CONT)-3-16-10YES-14-8
@FLOW 8YES-7-4
@FLOW 11YES-15NO-5
@FLOW 12YES-15YES-6
@BOX 2.0
PROC INCARD()
@BOX 4.0
GET.INCH => CH => INLINE
IS CH NOT NL OR NP OR EOF ?
@BOX 5.0
READ AND SAVE LABEL:3.2:
OF NEXT CARD
CONT CARD?
@BOX 6.0
RESULT = NL
@BOX 8.0
PAST COL 72 ON CARD?
@BOX 9.0
RESULT = CH
@BOX 10.0
READING HOLL AND END
OF LINE REACHED?
@BOX 14.0
SET CH=SPACE
@BOX 11.0
NOT SPACEFILLING LINE?
@BOX 12.0
PAST COL 72?
@BOX 13.0
INBACKSPACE(1)
IF CH = NL OR NP, REMOVE FROM INLINE
NOTE END OF CARD REACHED
@BOX 15.0
END OF COMPILATION?
@BOX 16.0
INLABEL => INLINE
RESET COLUMN NUMBER
@BOX 20.0
CH /= EOF  ?
@BOX 22.0
REMOVE CH FROM INLINE
SET EOF FLAG
@BOX 2.1
;PROC INCARD
;$IN I
;$LO8 CH
@BOX 16.1
;FOR I < ILSS.G+1 DO INLABEL.G[I] => INLINE.G[1+>INSS] OD
;IN.COL.G=>INP.CNT
@BOX 10.1
;IF READING.HOL = 2
@BOX 4.1
;IF GET.INCH() => CH => INLINE.G[1+>INSS]  /= NL.L /= NP.L /= EOF.L
@BOX 20.1
;IF CH /= EOF.L
@BOX 22.1
;1!>BITFLAGS.G
;1->INSS
@BOX 11.1
;IF READING.HOL = 0
@BOX 12.1
;1 => READING.HOL
;IF INP.CNT >= 72
@BOX 13.1
;2 => READING.HOL
;IN.BACKSPACE(1)
;IF CH = NL.L OR CH = NP.L  THEN 1->INSS FI
@BOX 15.1
;IF [LINE.G[0] = '* AND LINE.G[1] = 'E AND LINE.G[2] = 'N AND LINE.G[3] = 'D]
      OR BITFLAGS.G & 1 /= 0
@BOX 5.1
; %FD &> BITFLAGS.G
;IF READNEXTLB() => NEXTSTLABEL.G < 0
@BOX 6.1
; I.POS() => NEXTLINPAG.G
;NL.L=>INCARD
END
@BOX 14.1
;SPACE.L => CH
@BOX 8.1
;IF 1+>INP.CNT > 72
@BOX 9.1
;CH => INCARD
EXIT
@END
@TITLE FTN03.4(1,6)
@COL 2S-3R-4T-5R-6R
@COL 7F
@ROW 5-7
@FLOW 2-3-4NO-5-6-4YES-7
@BOX 2.0
PROC READ INTEGER
@BOX 3.0
CLEAR NO
@BOX 4.0
NEXT CH NOT A DIGIT?
@BOX 5.0
COMPUTE NO
@BOX 6.0
ADVANCE CH PTR
@BOX 7.0
RESULT = NO
@BOX 2.1
;PROC READINT
;INTEGER VALUE
;$LO8 CH
@BOX 3.1
;0 => VALUE
@BOX 4.1
;IF LINE.G[SS+1] => CH < '0 OR CH > '9
@BOX 5.1
;VALUE *10 + (CH-'0) => VALUE
@BOX 6.1
;1+>SS
@BOX 7.1
;VALUE => READINT
END
@END

