@X @~
~L3 COUK1247
80
~V7 56 2 -5
~D10
~H                    MUSS
~
~
~D10
~H             FTN091
~D10
~MMANCHESTER UNIVERSITY  -  CONFIDENTIAL~
~
~
                                                            ISSUE 10~
~V9 -1
~P
~V9 1
~YFTN091
~M~OFORTRAN 77 COMPILER IMPLEMENTATION DESCRIPTION
~S1~M~OSection 9~
~S1~OSection 9. Input/Output Statement Processing
~S1~O1.1 General Description
~BThis section performs the semantics for the Fortran Input/Output
statements FORMAT, READ, WRITE, PRINT, OPEN, CLOSE, INQUIRE, BACKSPACE,
ENDFILE and REWIND. The READ, WRITE and PRINT statements are data transfer
input/output statements. The OPEN, CLOSE, INQUIRE, BACKSPACE, ENDFILE and
REWIND statements are auxilliary input/output statements. The BACKSPACE,
ENDFILE and REWIND statements are file positioning input/output statements.
The semantic routines in this section perform various semantic checks
on the correctness of the statements and then plant code to call upon the
Fortran 77 run-time library to perform the actual input/output operations.
The Fortran 77 run-time library is described in the Fortran 77 I/O
implementation manual.
These procedures have the prefix FIO.
~BThe Format Table contains the information of Format statements
in an encoded form. The procedure FIO.C.FORMAT is called when compiling
a Format statement and this adds the encoding to the Format Table,
any character strings in the Format are stored separately from the
rest of the Format in the Format Strings Vector. FIO.C.FORMAT
returns the length of the encoded Format.
The two vectors are made of sufficient size for any formats
being compiled.
~S1~O1.2 Non Standard Features
~BA format specifier of an array name which is of integer, logical
or real datum is permitted as specified in appendix C of the
Fortran 77 standard.
~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 8 : (Control Statement Processing)~
   Section 11: (Expression Evaluation)~
   Section 12: (Property List Management)~
   Section 13: (Fault Monitoring)~
~S1~O2.2 Section Interface
~
Exported Scalars:~
   FMT.DICT.TYPE.G~
   RW.ARR.CNT.VAR.G~
   CUR.DO.IMPLIED.LABEL.G~
   FMT.DICT.NAME.G~
~
Exported Procedures:~
   FORMAT~
   FILE.POSITION~
   OPEN~
   CLOSE~
   INQUIRE~
   READWRITEPRINT~
   OPEN~
   CLOSE~
   INQUIRE~
   READWRITEPRINT~
~S1~O3. Implementation
~S1~O3.1 Outline of Operation
~S1~O3.1.1 FORMAT()
~BThis performs the semantics for the FORMAT statement.
Checks are made to ensure that it is
labelled and that the label has consistantly been used as a FORMAT
reference.
~S1~O3.1.2 FILE.POSITION()
~BThis performs the semantics for the file positioning I/O statements
REWIND, BACKSPACE and ENDFILE. Each of these statements has a compulsory
unit parameter which cannot be an internal file or asterisk.
~S1~O3.1.2.1 Code Planted~
~3
~
a) If the ERROR specifier is present then a~
   FIO.SET.FLT.RESTART(RESTART.LABEL) is planted.~
~
b) A call to the appropriate file position procedure is planted,~
    i.e.~
   FIO.REWIND(UNIT),~
   FIO.BSPACE(UNIT) or~
   FIO.ENDFILE(UNIT)~
~
c) If ERROR specifier is present a~
   RESTART LABEL is planted.~
~
d) If STATUS specifier is present plant~
   Call FIO.STATUS()~
   A=> STATUS data item.~
~
e) If ERROR specifier present plant~
   Call FIO.STATUS()~
   A  COMP  0~
   IF > 0, -> ERROR.LABEL~
~0
~S1~O3.1.3 OPEN()
~BThis performs the semantics for the OPEN statement.
~S1~O3.1.3.1 Code Planted
~BSteps a), c), d), e) are as in 3.1.2.1.
~S1b) A call to FIO.OPEN is planted.~
   FIO.OPEN(UNIT,FILE,STATUS,ACCESS,FORM,REC.LEN,BLANK)~
~S1~O3.1.4 CLOSE()
~BThis performs the semantics of the CLOSE statement, and is similar
to the semantics of the OPEN statement.
~S1~O3.1.4.1 Code Planted
~BSteps a), c), d), e) are as in 3.12.1.
~S1b) A call to FIO.CLOSE is planted.~
   FIO.CLOSE(UNIT,CLOSE.STATUS)~
~S1~O3.1.5 INQUIRE()
~BThis performs the semantics for the INQUIRE statement. A check is made
to ensure the inquiry is by file or unit and not both (or neither). The
semantics are similar to the other auxilliary I/O statements except
that INQUIRE returns results. The routine STORE.RESULT is used to pick
up the desired results of the inquiry and store in the correct data item.
~S1~O3.1.5.1 Code Planted
~BSteps a), c), d), e) are as in 3.1.2.1.
~S1b) A call to initiate inquiry requests is first planted.~
~3
~
   FIO.INQUIRE(UNIT,FILE)~
~BThereafter for each Enquiry specifier (besides File and Unit)
a call to the appropriate enquiry is planted and the result
stored in the associated data item.~
~
~
   e.g.~
       FIO.INQUIRE.RECL()~
~
           A => record length data item.~
~0
~S1~O3.1.6 READ WRITE PRINT()
~BThis performs the semantics for the data transfer input/output statements
READ, WRITE and PRINT. This uses the routines DEFINE.RESTART and
PROCESS.FAULT to handle the parameters IOSTAT,ERR and END. The UNIT
parameter is processed next and a check is made to ensure it is present
when the 'Clist' is present. The UNIT parameter is examined to see if
it is an internal file or an Integer unit or an asterisk and a suitable
parameter for the run-time routine is planted. If the unit is an internal
file then a check is made to ensure the REC parameter is absent. Next
a parameter to the run-time routine is planted to select either input
or output, and if it is output a check is made to ensure the EOF
parameter is absent.
~BThe Format for the input/output is processed next. If the Format
is absent un-formatted input/output is assumed. If the Format is an
asterisk then list-directed input/output is assumed, unless it is to an
an internal file or is direct access. If the Format is specified
by a simple integer specifying a Format label, then the appropriate Format index
is planted as a parameter to the run-time routine, if the statement
label has been used consistantly to refer to a Format. The remaining
possibilities for a Format are an Integer Scalar Variable which has
been ASSIGNed a Format statement label, or a character string or other
array containing the Hollerith representation of a Format when code for
run-time Format selection is planted.
~BNow the UNIT and Format have been established the run-time routine
for selecting them can be called. If the REC parameter is present
its expression is evaluated and a Direct Access Input/Output operation
is indicated, and a check for the absence of the EOF parameter is made.
Finally the list of items to be input or output can be processed.
~BThe planting of code for each item in the list involves calling the
correct run-time routine for each simple item, calling the DO loop
semantics to handle any implied DO's and planting loops to process
whole arrays. Any expressions for output must be evaluated, and any
subscripts processed.
~S1~O3.1.6.1 Code Planted
~Ba) If the END or ERROR specifier is present then
FIO.SET.FLT.RESTART(RESTART.LABEL) is planted.
~Bb) A call is planted to the appropriate unit selection procedure.~
~3
~
  FIO.SELECT.SEQ.UNIT(UNIT,FMT.TABLE^,FMT.STRINGS^,MODE),~
  FIO.SELECT.DA.UNIT(UNIT,FMT.TABLE^,FMT.STRINGS^,MODE), or~
  FIO.SELECT.STRING(STRING^,FMT.TABLE^,FMT.STRINGS^,MODE)~
~0
~BIf the Format specifier is an integer item containing the
statement label of the required Format a call to FIO.SELECT.FORMAT
is planted to obtain the Format index.
~BIf the Format specifier is a character string
a call to FIO.R.FORMAT is planted which encodes the Format
description at run time. If the Format specifier is a Hollerith
a call to FIO.HOLL.FORMAT is planted.
~Bc) For each item in the input/output list a call to the
appropriate read or write procedure in the Fortran library is
planted.
~BWhen an input/output item is an array a loop is planted. If
the array is adjustable, code is first planted to evaluate
the number of elements in the array.
~BWhen an input/output list item is a DO-implied list, then
the procedures F.DO and DO.LABEL which process the DO statement
are utilised to plant the DO loop control code.
~Bd) A call to FIO.E.READ or FIO.E.WRITE is planted.
~Be) If the END or ERROR specifier is present a RESTART LABEL is
planted.
~Bf) If STATUS specifier is present plant~
~3
      Call to FIO.STATUS()~
      A => STATUS data item.~
~Bg) If ERROR specifier is present plant~
      Call to FIO.STATUS()~
      A COMP 0~
      IF > 0, -> ERROR.LABEL~
~Bh) If END specifier is present plant~
      Call to FIO.STATUS()~
      A COMP 0~
      IF < 0, -> END.LABEL~
~0
~S1~O3.1.7 Additional Routines
~BThe routines DEFINE.RESTART and PROCESS.FAULT
are used to plant code to handle the optional parameters IOSTAT, ERR
and END.
~BDEFINE.RESTART plants a call to FIO.SET.FLT.RESTART, while
PROCESS.FAULT plants the necessary code to save the status, and
jumps to the Error and End Labels.
The routine PLANT.UNIT.PARAM handles the compulsory UNIT parameter to most
input/output statements.
~Y
~V9 -1
~P
~D15
~HFLOWCHARTS
~
~
~H                FTN091
~V9 -1
~F
@TITLE FTN09(1,11)
@COL 1S-2R-5R-7R-9F
@FLOW 1-2-5-7-9
@BOX 1.0
INPUT/OUTPUT STATEMENTS
@BOX 2.0
[IMPORTS FTN09/1]
MODULE HEADING
@BOX 5.0
SCALAR DECLARATIONS
@BOX 7.0
PROCEDURES IN MODULE
   FORMAT STATEMENT:9.1:
   AUX I/O STATEMENT:9.2:
   READ/WRITE/PRINT:9.3:
   DEFINE.RESTART:9.4:
   PROCESS.FAULT:9.5:
   PLANT.UNIT.PARAM:9.6:
   CONVERT.DATA.ITEM.INTO.EXPR:9.7:
@BOX 9.0
END
@BOX 2.1
#FTN09/1
;MODULE (FORMAT,FILE.POSITION,READ.WRITE.PRINT,OPEN,CLOSE,
         INQUIRE,CUR.DO.IMPLIED.LABEL.G,FMT.DICT.TYPE.G,
         RW.ARR.CNT.VAR.G,FMT.DICT.NAME.G,OPEN.DEFAULT.VAL.G,
         FORMAT.LIST.ROOT); :: @@@ BCT 28-DEC-82
@BOX 5.1
; *GLOBAL 2
;ADDR FORMAT.LIST FORMAT.LIST.ROOT :: @@@ BCT 28-DEC-82
;$IN FMT.DICT.TYPE.G, RWARR.CNT.VAR.G
;$IN32 CUR.DO.IMPLIED.LABEL.G
;$LO16 FMT.DICT.NAME.G
;$LO8 OPENDEFAULT.VAL.G
; *GLOBAL 0
@BOX 7.1
;P.SPEC FORMAT()
;P.SPEC FILE.POSITION()
;P.SPEC READ.WRITE.PRINT()
;P.SPEC OPEN()
;P.SPEC CLOSE()
;P.SPEC INQUIRE()
;PSPEC PROCESS.FAULT($IN,$IN,$IN,$IN)
;PSPEC PLANT.UNIT.PARAM($IN)
;PSPEC CONVERT.DATA.ITEM.TO.EXPR($IN)/$IN
;PSPEC DEFINE.RESTART($IN,$IN)/$IN
#FTN09.1
#FTN09.2
#FTN09.3
#FTN09.4
#FTN09.5
#FTN09.6
#FTN09.7
@BOX 9.1
;*END
@END
@TITLE FTN09/1(1,11)
@COL 1S-2R
@COL 3R-4R-5R-6R-7F
@FLOW 1-2-3-4-5-6-7
@BOX 1.0
I/O IMPORTS
@BOX 2.0
IMPORTED TYPES
@BOX 3.0
IMPORTED LITERALS
@BOX 4.0
IMPORTED SCALARS
@BOX 5.0
IMPORTED VECTORS
@BOX 6.0
IMPORTED PROCEDURES
@BOX 7.0
END
@BOX 2.1
;IMPORT TYPE EQUIV.PROP
;TYPE NAME.T IS $AD[$LO8] NAME :: ??? JM 27-DEC-82
;TYPE PROPS;
;TYPE LOCAL.PROP;
;TYPE CONST.PROP;
;TYPE GLOBAL.PROP IS
       ADDR GLOBAL.PROP G.NEXT.P
       NAME.T G.NAME
       $LO8 G.KIND
       $LO16 G.TL.NAME
       ADDR [$LO8] G.ARG.SPEC.P
;TYPE L.ALT.TYPE IS
       ADDR CONST.PROP L.CONST.P OR
       ADDR EQUIV.PROP L.EQT.P
       $IN L.DISP OR
       ADDR [$LO8] L.ARG.SPEC.P
       $LO8 L.INTR.NO
       $LO16 L.CH.RES.NAME
       $LO16 L.SPEC.TL.NAME OR
       ADDR [$IN] L.AS.DUMP
       ADDR [PROPS] L.PROPS.T.DUMP
;TYPE LOCAL.PROP IS
       ADDR LOCAL.PROP L.NEXT.P
       NAME.T L.NAME
       ADDR LOCAL.PROP L.LINK1, L.LINK2
       $LO8 LTYPE
       $LO16 LSPECS, LKIND
       $IN L.LEN
       $LO16 L.TL.NAME
       ADDR [$IN] L.ARR.SPEC.P
       L.ALT.TYPE L.ALT
;TYPE COMMON.PROP IS
       ADDR COMMON.PROP C.NEXT.P
       NAME.T C.NAME
       $LO8 C.KIND
       ADDR LOCAL.PROP C.HEAD, C.TAIL
       ADDR C.SIZE
       ADDR COMMON.PROP C.PREV.P
       $LO8 C.AREA.NO
;TYPE LABEL.PROP IS
       ADDR LABEL.PROP S.NEXT.P
       $LO24 S.NAME
       $LO8 S.KIND
       $LO16 S.LEVEL, S.BLOCK, S.TL.NAME, S.ID
;TYPE PROPS IS
      $IN32 INT OR
       ADDR ADDRESS OR
       ADDR LOCAL.PROP LOC OR
       ADDR GLOBAL.PROP GLOB OR
       ADDR COMMON.PROP COM OR
       ADDR CONST.PROP CONST
 ;TYPE CONST.PROP IS
       $IN32 INT.CONST OR
       $RE32 REAL.CONST OR
       $RE64 DP.CONST OR
       $RE32 R.COMP.CONST, I.COMP.CONST OR
       $LO16 LOG.CONST OR
       ADDR[$LO8] CH.CONST OR
       $LO64 T.CONST OR
       $LO8[8] H.CONST
       $LO8 H.PR :: @@@ BCT 30-DEC-82
;TYPE FORMAT.LIST IS
     ADDR LABEL.PROP F.LABEL
     $IN F.BND
     ADDR [$IN] F.TABLE
     ADDR [$LO8] F.STRINGS
     ADDR FORMAT.LIST NEXT :: @@@ BCT 28-DEC-82
@BOX 3.1
;IMPORT LITERAL FIO.OPEN,FIO.CLOSE,FIO.INQUIRE.EXIST,
        FIO.INQUIRE, FIO.REWIND,
        FIO.EREAD,FIO.EWRITE,FIO.SELECT.DA.UNIT,FIO.SELECT.SEQ.UNIT,FIO.SELECT.S
TRING,
        FIO.R.FORMAT,FIO.SELECT.FORMAT,FIO.SET.FLT.RESTART,FIO.STATUS
;IMPORT LITERAL FMT.TABLE.PTR.TYPE.L,FMT.TABLE.EL.TYPE.L,STR.ARR.BASE.OP.L,
        MAX.FMT.TABLE.L,MAX.FMT.STRINGS.L,AS.Z.L,PROPS.Z.L,I.ACC.T.L,
        R.ACC.T.L,DP.ACC.T.L,L.ACC.T.L,LOCAL.SPACE :: @@@ BCT 28-DEC-82
@BOX 4.1
;$IN I.ACC.Z.G
;$IN STAT.AP.G, F.L.PROP.ADDR.G, MUTLN.G, CUR.A.TYPE.G
;ADDR LOCAL.PROP F.L.PROP.G
;$IN32 CURRENT.LABEL.G
;$LO8 LABEL.FAULTY.G
;ADDR LABEL.PROP CURRENT.LABEL.PTR.G
; $LO16 TL.ZERO.G,TL.ONE.G
;$IN PROPS.I,END.AP.G, A.AP.G, B.AP.G
;$IN DONE.DECLARATIONS
@BOX 5.1
; $IN16 [MAX.FMT.TABLE.L] FMT.TABLE
; $LO8 [MAX.FMT.STRINGS.L] FMT.STRINGS
; $IN[AS.Z.L] AS
; $LO8[5] F.PR.T
;PROPS[PROPS.Z.L] PROPS.T
@BOX 6.1
;P.SPEC FAULT($IN,$IN)
;P.SPEC F.DO()
;P.SPEC DO.LABEL($LO24)
;P.SPEC PROCESS.STAT.REF($IN,$LO24)/ADDR LABEL.PROP
;P.SPEC REDUCE.EXPR($IN)/$IN
;P.SPEC CODE.EXPR($IN,$IN)/$IN
;P.SPEC PL.ARITH.FN($IN,$IN)
;P.SPEC SET.A.TYPE($IN,$IN)
;P.SPEC SET.B.TYPE($IN)
;P.SPEC MUTL.TYPE($IN, $IN)/$IN
;P.SPEC CODE.SUBSCRIPTS($IN,$IN,$IN)/$IN
;P.SPEC CREATE.CHAR.EXPR.DUMP($IN)/$IN
;P.SPEC DECL.CHAR.CONST($IN)/$IN
;P.SPEC PL.STK.LB($LO8,$IN)
;P.SPEC LOAD.REGS.FOR.CHAR.ARRAY.EL.REFN(ADDR LOCAL.PROP)
;P.SPEC PL.LOAD.STR($IN,$IN)
;P.SPEC PL.STK.PAR($IN)
;P.SPEC MAKE.FORMAT.LIST($IN)/ADDR FORMAT.LIST :: @@@ BCT 28-DEC-82
;P.SPEC MAKE.IN($IN,$IN)/ADDR [$IN] :: @@@ BCT 28-DEC-82
;P.SPEC MAKE.LO8($IN,$IN)/ADDR [$LO8] :: @@@ BCT 28-DEC-82
;L.SPEC TL.ASS($IN,$IN)
;L.SPEC TL.C.LIT.32($IN,$IN32)
;L.SPEC TL.ASS.VALUE($IN,$IN)
;L.SPEC TL.ASS.END()
;L.SPEC TL.C.LIT.S($IN,ADDR[$LO8])
;L.SPEC TL.PL($IN,$IN)
;L.SPEC TL.C.NULL($IN)
;L.SPEC TL.S.DECL(ADDR[$LO8],$IN,ADDR)
;L.SPEC TL.LABEL.SPEC(ADDR[$LO8],$IN)
;L.SPEC TL.LABEL($IN)
;L.SPEC TL.REG($IN)
;L.SPEC TL.LIT(ADDR[$LO8],$IN)
;L.SPEC TL.C.LIT16($IN,$IN16)
;L.SPEC TL.CV.CYCLE($IN,$IN,$IN)
;L.SPEC TL.CV.LIMIT($IN)
;L.SPEC TL.REPEAT()
@END
@TITLE FTN09.1(1,11)
@COL 1S-2T-3T-4T-6R-7F
@COL 8R-5R
@ROW 4-8
@FLOW 1-2N-3N-4N-6-7
@FLOW 2Y-7
@FLOW 3Y-8-7
@FLOW 4Y-5-7
@BOX 1.0
FORMAT
@BOX 2.0
FAULTY LABEL
@BOX 3.0
NO LABEL
@BOX 4.0
WITHIN DECLARATIONS?
@BOX 5.0
SAVE FORMAT INFO
FOR LATER PROCESSING
@BOX 6.0
PLANT FORMAT TABLES
@BOX 8.0
FAULT
@BOX 7.0
END
@BOX 1.1
;PROC FORMAT
; $IN X,Z,I
;ADDR FORMAT.LIST NODE :: @@@ BCT 28-DEC-82
;LITERAL/ADDR [$LO8] NIL.STRING = :: @@@ BCT 28-DEC-82
@BOX 2.1
;IF LABEL.FAULTY.G /= 0
@BOX 3.1
;IF CURRENT.LABEL.G = 0
@BOX 4.1
:: @@@ BCT 28-DEC-82 Start of new code
;IF DONE.DECLARATIONS = 0
@BOX 5.1
;MAKE.FORMAT.LIST(LOCAL.SPACE) => NODE
;FORMAT.LIST.ROOT => NEXT OF NODE^
;NODE => FORMAT.LIST.ROOT
;SELECT NODE^
;AS[STAT.AP.G] => Z => F.BND
;CURRENT.LABEL.PTR.G => F.LABEL
;MAKE.IN(Z,LOCAL.SPACE) => F.TABLE
;FOR I < Z DO
   FMT.TABLE[I] => F.TABLE^[I] OD
; -1 => Z
; WHILE FMT.STRINGS[1+>Z] /= 0 DO OD
;IF Z > 0 THEN
     MAKE.LO8(Z,LOCAL.SPACE) => F.STRINGS
   ; FOR I < Z DO
        FMT.STRINGS[I] => F.STRINGS^[I] OD
 ELSE NIL.STRING => F.STRINGS FI
:: @@@ BCT 28-DEC-82 End of new code
@BOX 6.1
; AS[STAT.AP.G] => Z
; TL.ASS(S.TL.NAME OF CURRENT.LABEL.PTR.G^ => X,-1)
; -1 => I
; WHILE 1 +> I < Z DO
     TL.C.LIT.32(FMT.TABLE.EL.TYPE.L,FMT.TABLE[I])
     ; TL.ASS.VALUE(0,1)
 OD
; TL.ASS.END()
; TL.ASS(X+1,-1)
; -1 => I
; WHILE FMT.STRINGS[1+> I] /= 0  DO OD
;IF I > 0 THEN
     TL.C.LIT.S(%80,PART(^FMT.STRINGS,0,I-1))
     ; TL.ASS.VALUE(0,1)
 FI
; TL.ASS.END()
@BOX 7.1
;END
@BOX 8.1
;FAULT(%11E,1)
@END
@TITLE FTN09.2(1,6)
@COL 1S-2R-3R-4R-5F
@FLOW 1-2-3-4-5
@BOX 1.0
AUX I/O STATEMENTS
@BOX 2.0
FILE POSITIONING STATEMENTS
:9.2.1:
REWIND
BACKSPACE
ENDFILE
@BOX 3.0
OPEN:9.2.2:
CLOSE:9.2.3:
INQUIRE:9.2.4:
@BOX 4.0
ROUTINES USED BY ABOVE
PLANT OPTION I  PARAM:9.2.5:
PLANT OPTION CH PARAM :9.2.6:
@BOX 5.0
END
@BOX 1.1
;PSPEC PLANT.OPTION.I.PARAM($IN,$IN)
;PSPEC PLANT.OPTION.CH.PARAM($IN)
@BOX 2.1
#FTN09.2.1
@BOX 3.1
#FTN09.2.2
#FTN09.2.3
#FTN09.2.4
@BOX 4.1
#FTN09.2.5
#FTN09.2.6
@BOX 5.1
@END
@TITLE FTN09.2.1(1,6)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
FILE POSITIONING STATEMENTS
REWIND, BACKSPACE AND ENDFILE
@BOX 2.0
DEFINE.RESTART(IOSTAT,ERR,END) => RESTART:9.4:
PLANT STACK LINK:11.22:
PLANT.UNIT.PARAM(UNIT):9.6:
PLANT.ENTER
PROCESS.FAULT(IOSTAT,RESTART,ERR,END):9.5:
@BOX 3.0
END
@BOX 1.1
;PROC FILE.POSITION
;$IN R,AP,ERR
@BOX 2.1
;DEFINE.RESTART(AS[STAT.AP.G=>AP+2] => ERR,-1) => R
;PL.STK.LB(AS[AP]+FIO.REWIND,0)
;PLANT.UNIT.PARAM(AS[AP+1])
;TL.PL(%42,0)
;PROCESS.FAULT(AS[AP+3],ERR,-1,R)
@BOX 3.1
;END
@END
@TITLE FTN09.2.2(1,6)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
OPEN.STATEMENT
@BOX 2.0
DEFINE.RESTART(IOSTAT,ERR,-1)RESTART:9.4:
PLANT STACK LINK:11.22:
PLANT.UNIT.PARAM(UNIT):9.6:
PLANT.OPTION.CH.PARAM(FILE):9.2.6:
PLANT.OPTION.CH.PARAM(STATUS):9.2.6:
PLANT.OPTION.CH.PARAM(ACCESS):9.2.6:
PLANT.OPTION.CH.PARAM(FORM):9.2.6:
PLANT.OPTION.I.PARAM(RECL,Q):9.2.5:
PLANT.OPTION.CH.PARAM(BLANK):9.2.6:
PLANT DEFAULT MODE:11.24:
PLANT.ENTER
PROCESS.FAULT(IOSTAT,ERR,-1,RESTART):9.5:
@BOX 3.0
END
@BOX 1.1
;PROC OPEN
;$IN R,AP,ER
@BOX 2.1
;DEFINE.RESTART(AS[STAT.AP.G=>AP+1]=>ER,-1) => R
;PL.STK.LB(FIO.OPEN,0)
;PLANT.UNIT.PARAM(AS[AP])
;PLANT.OPTION.CH.PARAM(AS[AP+2])
;PLANT.OPTION.CH.PARAM(AS[AP+3])
;PLANT.OPTION.CH.PARAM(AS[AP+4])
;PLANT.OPTION.CH.PARAM(AS[AP+5])
;PLANT.OPTION.I.PARAM(AS[AP+6],0)
;PLANT.OPTION.CH.PARAM(AS[AP+7])
;PL.STK.PAR(OPENDEFAULT.VAL.G)
;TL.PL(%42,0)
;PROCESS.FAULT(AS[AP+8],ER,-1,R)
@BOX 3.1
END
@END
@TITLE FTN09.2.3(1,6)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
CLOSE STATEMENT
@BOX 2.0
DEFINE.RESTART(ERR,-1)=>RESTART:9.4:
PLANT STACK LINK:11.22:
PLANT.UNIT.PARAM(UNIT):9.6:
PLANT.OPTION.CH.PARAM(STATUS):9.2.6:
PLANT.ENTER
PROCESS.FAULT(IOSTAT,ERR,-1,RESTART):9.5:
@BOX 3.0
END
@BOX 1.1
;PROC CLOSE
;$IN AP,R,ER
@BOX 2.1
;DEFINE.RESTART(AS[STAT.AP.G=>AP+1]=>ER,-1) => R
;PL.STK.LB(FIO.CLOSE,0)
;PLANT.UNIT.PARAM(AS[AP])
;PLANT.OPTION.CH.PARAM(AS[AP+2])
;TL.PL(%42,0)
;PROCESS.FAULT(AS[AP+3],ER,-1,R)
@BOX 3.1
;END
@END
@TITLE FTN09.2.4(1,11)
@COL 1S-2R-3T-4R-5R-6R-7F
@COL 8R
@ROW 4-8
@FLOW 1-2-3N-4-5-6-7
@FLOW 3Y-8-7
@BOX 1.0
INQUIRE STATEMENT
@BOX 2.0
ROUTINES
PLANT INQUIRE QUERY
:9.2.4.1:
@BOX 3.0
ARE THE UNIT & FILE PARAMS BOTH PRESENT OR BOTH ABSENT?
@BOX 4.0
DEFINE.RESTART(ERR,-1) => RESTART:9.4:
PLANT.STACKLINK:11.22:
PLANT.OPTION.I.PARAM(UNIT,-1):9.2.5:
PLANT.OPTION.CH.PARAM(FILE):9.2.6:
PLANT ENTER INQUIRE
@BOX 5.0
PLANT INQUIRE.QUERY(EXIST,LOG):9.2.4.1:
PLANT INQUIRE.QUERY(OPENED,LOG):9.2.4.1:
PLANT INQUIRE.QUERY(NUMBER,INT):9.2.4.1:
PLANT INQUIRE.QUERY(NAMED,LOG):9.2.4.1:
PLANT INQUIRE.QUERY(NAME,CHAR):9.2.4.1:
PLANT INQUIRE.QUERY(ACCESS,CHAR):9.2.4.1:
PLANT INQUIRE.QUERY(SEQ,CHAR):9.2.4.1:
PLANT.INQUIRE.QUERY(DIR,CHAR):9.2.4.1:
PLANT INQUIRE.QUERY(FORM,CHAR):9.2.4.1:
PLANT INQUIRE.QUERY(FORMATTED,CHAR):9.2.4.1:
PLANT INQUIRE.QUERY(UNFORMATTED,CHAR):9.2.4.1:
PLANT INQUIRE.QUERY(RECL,INT):9.2.4.1:
PLANT INQUIRE.QUERY(NEXT.REC,INT):9.2.4.1:
PLANT INQUIRE.QUERY(BLANK,CHAR):9.2.4.1:
@BOX 6.0
PROCESS FAULT(IOSTAT,ERR,-1,RESTART):9.5:
@BOX 7.0
END
@BOX 8.0
FAULT
@BOX 1.1
;PROC INQUIRE
;$IN R,AP,ER,I,T
;DATAVEC TYPES($LO8)
4  4  3  4
5  5  5  5
5  5  5  3
3  5
END
;DATAVEC RES($LO8)
%4C %84 %83
END
@BOX 2.1
;PSPEC PLANT.INQUIRE.QUERY($IN32,$IN,$IN);

#FTN09.2.4.1
@BOX 3.1
;IF AS[STAT.AP.G=>AP] * AS[AP+1] >= 0
@BOX 5.1
;-1 => I
;WHILE 1 +> I < 14 DO
     ;IF AS[AP+I+4] => T >= 0 THEN
           ;PLANT.INQUIRE.QUERY(I,T,TYPES[I])
     ;FI
;OD
@BOX 4.1
;DEFINE.RESTART(AS[AP+2]=>ER,-1) => R
;PL.STK.LB(FIO.INQUIRE,0)
;PLANT.OPTION.I.PARAM(AS[AP],-1)
;PLANT.OPTION.CH.PARAM(AS[AP+1])
;TL.PL(%42,0)
@BOX 6.1
;PROCESS.FAULT(AS[AP+2],ER,-1,R)
@BOX 7.1
;END
@BOX 8.1
;FAULT(27,1)
@END
@TITLE FTN09.2.4.1(1,11)
@COL 1S-2R-3T-4R-5T-6R-7R-8F
@COL 9R-10R-11R
@ROW 4-9
@ROW 6-10
@FLOW 1-2-3N-4-5N-6-7-8
@FLOW 3Y-9-8
@FLOW 5Y-10-11-8
@BOX 1.0
PLANT.INQUIRE.QUERY(INQUIRE.QUERY.FIND.N,AR,TYPE)
@BOX 2.0
CONVERT DATA ITEM TO EXPR:9.7:
@BOX 3.0
REDUCE.EXPR:11.1:
INVALID?
@BOX 4.0
PLANT STACK LINK:11.22:
@BOX 5.0
CHAR TYPE
@BOX 6.0
PLANT ENTER INQUIRE PROC
@BOX 7.0
PLANT ACONV IF NECESSARY
PLANT A => :11.13:
@BOX 8.0
END
@BOX 9.0
FAULT
@BOX 10.0
CODE D = REF :11.2:
@BOX 11.0
PLANT ENTER INQUIRE PROC
@BOX 1.1
;PROC PLANT.INQUIRE.QUERY(FN,AP,TY)
;$IN PR
@BOX 2.1
;CONVERT.DATA.ITEM.TO.EXPR(AP => F.L.PROP.ADDR.G) => AP
@BOX 3.1
;IF REDUCE.EXPR(AP) & %343F /= TY
@BOX 4.1
;PL.STK.LB(FIO.INQUIRE.EXIST+FN,RES[TY-3])
@BOX 5.1
;IF TY = 5
@BOX 6.1
;TL.PL(%42,0)
@BOX 7.1
;IF AS[AP] ->> 5 & 7 /= 5-TY THEN
    SET.A.TYPE(TY!%10,5-TY)
 FI
;PL.ARITH.FN(%20,AP)
@BOX 8.1
;END
@BOX 9.1
;FAULT(29,5)
@BOX 10.1
;CODE.EXPR(AP,%60)
@BOX 11.1
;TL.PL(%42,0)
@END
@TITLE FTN09.2.5(1,11)
@COL 1S-2T-3T-4R-8R-5F
@COL 7R-6R
@ROW 4-7
@FLOW 1-2N-3N-4-8-5
@FLOW 2Y-6-8
@FLOW 3Y-7-6
@BOX 1.0
PLANT.OPTION.IPARAM(A/R,DEFAULT)
@BOX 2.0
IS PARAM ABSENT?
@BOX 3.0
REDUCE EXPR:11.1:
INVALID?
@BOX 4.0
CODE.EXPR:11.2:
PLANT ACONV TO I32 IF NECESSARY
RESET A AND B USE INFO
@BOX 5.0
END
@BOX 6.0
PLANT DEFAULT
@BOX 7.0
FAULT
@BOX 8.0
PLANT STACK A
@BOX 1.1
;PROC PLANT.OPTION.I.PARAM(AP,DEF)
@BOX 2.1
;IF AP < 0
@BOX 3.1
;IF REDUCE.EXPR(AP => F.L.PROP.ADDR.G) & %340F /= 3
@BOX 4.1
;CODE.EXPR(AP,%22)
;IF AS[AP] & %E0 /= %40 THEN
    SET.A.TYPE(%13,2)
 FI
;-1 => A.AP.G => B.AP.G
@BOX 5.1
;END
@BOX 6.1
;SET.A.TYPE(3,2)
;TL.C.LIT.32(I.ACC.T.L,DEF)
;TL.PL(%22,0)
@BOX 7.1
;FAULT(29,5)
@BOX 8.1
;TL.PL(%41, %3000)
@END
@TITLE FTN09.2.6(1,6)
@COL 1S-2T-3T-4R-5F
@COL 7R-6R
@ROW 4-7
@FLOW 1-2N-3N-4-5
@FLOW 2Y-6-5
@FLOW 3Y-7-6
@BOX 1.0
PLANT OPTION CH PARAM(A/R)
@BOX 2.0
PARAM ABSENT
@BOX 3.0
REDUCE.EXPR:11.1:
INVALID?
@BOX 4.0
CODE EXPR:11.2:
PLANT PARAM
@BOX 5.0
END
@BOX 6.0
PLANT DEFAULT
@BOX 7.0
FAULT
@BOX 1.1
;PROC PLANT.OPTION.CH.PARAM(AP)
@BOX 2.1
;SET.A.TYPE(6,0)
;IF AP < 0
@BOX 3.1
;IF REDUCE.EXPR(AP => F.L.PROP.ADDR.G) & %340F /= 5
@BOX 4.1
;CODE.EXPR(AP,%21)
;TL.PL(%41,%3000)
@BOX 5.1
;END
@BOX 6.1
;TL.C.NULL(%83)
;TL.PL(%22,0)
;TL.PL(%41,%3000)
@BOX 7.1
;FAULT(29,5)
@END
@TITLE FTN09.3(1,11)
@COL 14R
@COL 1S-2R-21T-22R-3R-4T-5T-6R-7R-8R-9T-11R-12R-13F
@COL 16T-19T-17R-18R-20R
@ROW 14-7
@ROW 11-16
@FLOW 1-2-21N-22-3-4N-5N-6-7-8-9N-11-12-13
@FLOW 21Y-3
@FLOW 4Y-14-8
@FLOW 9Y-16N-19N-17-11
@FLOW 16Y-18-13
@FLOW 5Y-7
@FLOW 19Y-20-13
@BOX 1.0
READ WRITE PRINT
@BOX 2.0
ROUTINES
CODE.TO.LIST:9.3.3:
@BOX 21.0
NOT IBM FORMAT
@BOX 22.0
WARNING
@BOX 3.0
DEFINE.RESTART(ERR,END,RESTART):9.4:
SELECT.UNIT:9.3.1:
RESET A AND B USE INFO
@BOX 4.0
READING?
@BOX 5.0
EOF ABSENT?
@BOX 6.0
WARNING
@BOX 7.0
PLANT SELECT OUTPUT
@BOX 8.0
SELECT.FORMAT:9.3.2:
@BOX 9.0
REC PARAM PRESENT?
@BOX 11.0
PLANT ENTER
@BOX 12.0
SET NEXT DO IMPLIED LABEL
SELECT APPROPRIATE SET OR RW PERM PROCS
CODE.IOLIST:9.3.3:
PLANT SUITABLE END.IO :11.22:
PROCESS FAULT(IOSTAT,ERR,END,RESTART):9.5:
@BOX 13.0
END
@BOX 14.0
PLANT SELECT INPUT
@BOX 16.0
EOF PRESENT?
@BOX 17.0
CODE.EXPR:11.3:
PLANT 32 BIT REC PARAM
RESET A AND B USE INFO
@BOX 18.0
FAULT
@BOX 19.0
REDUCE EXPR:11.12:
EXPR INVALID
@BOX 20.0
FAULT
@BOX 1.1
;PROC READ.WRITE.PRINT
;LITERAL/ADDR LABEL.PROP NIL.SP=
;LITERAL/ADDR[$LO8] NIL.STR =
;ADDR CONST.PROP CP
; $IN32 T
;$IN R,FMT0,UNIT.FL,U,ET,AP,ER,EN,REC,RWP,IO
;$IN IFILE,FMT,RW.PROC.SET,PR,UK,A.FN
;$IN32 L
;ADDR LABEL.PROP SP
;DATAVEC RW.RES($IN)
R.ACC.T.L DP.ACC.T.L 0
%40 %44 %4C %80 %84 %8C 0
R.ACC.T.L DP.ACC.T.L 0
%40 %44 %4C %80 %84 %8C 0
0[40]
END
;DATAVEC RW.POS($LO8)
0 1 2 3 6 9
END
;0 => IFILE
@BOX 2.1
;PSPEC CODE.IO.LIST($IN)
#FTN09.3.3
@BOX 21.1
;IF AS[STAT.AP.G=>AP+7] /= 2
@BOX 22.1
;FAULT(161, 6)
@BOX 3.1
;DEFINE.RESTART(AS[AP+5] => ER,AS[AP+4]=>EN) => R
;AS[AP+3] => REC
;AS[AP] => RWP
#FTN09.3.1
;-1 => A.AP.G => B.AP.G
@BOX 4.1
;IF RWP&1 = 0
@BOX 5.1
;IF EN < 0
@BOX 6.1
;FAULT(69,1)
@BOX 7.1
;8 => IO
@BOX 8.1
#FTN09.3.2
@BOX 14.1
;4 => IO
@BOX 9.1
;IF REC >= 0 AND RWP < 2
@BOX 11.1
;TL.PL(%42,0)
;-1 => CUR.A.TYPE.G
@BOX 12.1
;100000 => CUR.DO.IMPLIED.LABEL.G
;(IF IO = 4 THEN 0 ELSE 30) => RW.PROC.SET
;IF FMT =< 0 THEN
     ;FMT+2*10+>RW.PROC.SET
;FI
;IF AS[AP+8] => T > 0 THEN
     ;CODE.IO.LIST(T)
;FI
;(IF IO = 4 THEN FIO.EREAD
   ELSE FIO.EWRITE) => T
;PL.STK.LB(T,0)
;TL.PL(%42,0)
;PROCESS.FAULT(AS[AP+6],ER,EN,R)
@BOX 13.1
;END
@BOX 16.1
;IF EN >= 0
@BOX 19.1
;IF REDUCE.EXPR(REC) & %340F /= 3
@BOX 17.1
;CODE.EXPR(REC,%22)
;IF AS[REC] & %E0 /= %40 THEN
    SET.A.TYPE(%13,2)
 FI
;TL.PL(%41,%3000)
;-1 => B.AP.G => A.AP.G
@BOX 18.1
;FAULT(13,1)
@BOX 20.1
;FAULT(70,1)
@END
@TITLE FTN09.3.1(1,11)
@COL 18R-9T-10R-11R
@COL 1S-2T-21R-19T-20R-16T-17R-4T-5R-7N-8F
@COL 15R-12T-13R-14R
@ROW 18-17
@ROW 17-12
@ROW 9-5
@ROW 11-7
@ROW 16-15
@FLOW 1-2N-21-19N-20-8
@FLOW 19Y-16N-17-4N-5-7-8
@FLOW 2Y-15-12N-13-7
@FLOW 14-7
@FLOW 4Y-9N-10-7
@FLOW 9Y-11-7
@FLOW 12Y-14
@FLOW 16Y-18-7
@BOX 1.0
SELECT UNIT
@BOX 2.0
UNIT ABSENT OR *?
@BOX 4.0
UNIT AN INTERNAL FILE?
@BOX 5.0
PLANT 32 BIT UNIT.PARAM
@BOX 8.0
END
@BOX 9.0
REC PARAM PRES?
@BOX 10.0
NOTE INTERNAL FILE
OBTAIN BYTE VECTOR PTR
PLANT STRING PARAM
@BOX 11.0
FAULT
@BOX 12.0
PRINT OR
SIMPLE READ OR *
@BOX 13.0
FAULT
@BOX 14.0
PLANT 0 PARAM
@BOX 15.0
PLANT STACKLINK FOR SELECT SEQ UNIT
NOTE UNIT NOT DEFINED :11.22:
@BOX 17.0
DETERMINE KIND OF UNIT TO BE SELECTED
PLANT STACKLINK FOR
     SELECTSEQUNIT OR
     SELECTDAUNIT OR
     SELECTSTR   :11.22:
@BOX 16.0
NOTE UNIT DEFINED
INVALID?
@BOX 18.0
FAULT
@BOX 21.0
NOTE UNIT DEFINED
REDUCE EXPR
@BOX 19.0
NOT ENCODE DECODE
@BOX 20.0
PROCESS ENCODE/DECODE[09.3.1.1]
@BOX 1.1
@BOX 2.1
;IF AS[AP+1] => U =< 0
@BOX 21.1
; 0 => UNIT.FL
; REDUCE.EXPR(U) => ET
@BOX 19.1
; IF RWP < 2
@BOX 20.1
#FTN09.3.1.1
@BOX 16.1
;IF ET & %340F /= 3
     AND [ET & %F /= 5 OR
      AS[U] & %1F /= %12 /= %13 /= %18 /= %1B]
@BOX 17.1
;IF REC >= 0 THEN
      ;FIO.SELECT.DA.UNIT => T
;ELSE IF ET & %F = 3 THEN
      ;FIO.SELECT.SEQ.UNIT => T
;ELSE
      ;FIO.SELECT.STRING => T
;FI  FI
;PL.STK.LB(T,0)
@BOX 4.1
;IF E.T & %F = 5
@BOX 5.1
;CODE.EXPR(U,%22)
;IF AS[U] & %E0 /= %40 THEN
    SET.A.TYPE(%13,2)
 FI
;TL.PL(%41,%3000)
@BOX 15.1
;PL.STK.LB(FIO.SELECT.SEQ.UNIT,0)
;%10 => UNIT.FL
@BOX 8.1
@BOX 9.1
;IF REC >= 0
@BOX 10.1
;1 => I.FILE
;SET.A.TYPE(6,0)
;PL.LOAD.STR(%61,U)
;TL.PL(%41,%3000)
@BOX 11.1
;FAULT(73,1)
@BOX 12.1
;IF AS[AP+7] = 0 OR U = 0
@BOX 13.1
;FAULT(71,1)
@BOX 14.1
;SET.A.TYPE(3,2)
;TL.PL(%22,TL.ZERO.G)
;TL.PL(%41,%3000)
@BOX 18.1
;FAULT(72,1)
@END
@TITLE FTN09.3.1.1(1,11)
@COL 14R-15R-16R
@COL 1S-2R-3T-4T-5R-6T-8T-9R-10R-11R-12R-13F
@COL 17R
@ROW 14-4
@ROW 16-9-17
@FLOW 1-2-3N-4N-5-6N-8Array-9-10-11-12-13
@FLOW 3Y-14-13
@FLOW 4Y-15-13
@FLOW 6Y-16-11
@FLOW 8Variable-17-10
@BOX 1.0
SELECT ENCODE/DECODE UNIT
@BOX 2.0
ISSUE NON-STANDARD WARNING
@BOX 3.0
INVALID UNIT?
@BOX 4.0
REDUCE LENGTH
EXPRESSION INVALID?
@BOX 5.0
NOTE IF UNIT A DUMMY ARG
PLANT STACKLINK SELECT STRING
NOTE INTERNAL FILE
@BOX 6.0
CHARACTER UNIT?
@BOX 8.0
VARIABLE/ARRAY
@BOX 9.0
SET A TYPE
CODE SUBSCRIPTS
PLANT D=REF/D=
PLANT SEL/EL
PLANT A=D[]
@BOX 10.0
PLANT CONVERT TO ADDR
CONVERT TO BYTE VECTOR
@BOX 11.0
LOAD LENGTH INTO B
@BOX 12.0
PLANT LIMIT
STACK A
@BOX 13.0
END
@BOX 14.0
FAULT
@BOX 15.0
FAULT
@BOX 16.0
PLANT CODE TO
OBTAIN BYTE
VECTOR IN A
@BOX 17.0
SET A TYPE
PLANT A=REF
PLANT A=
@BOX 1.1
:: BEGIN
@BOX 2.1
;FAULT(162, 6)
@BOX 3.1
;IF AS[U] & %1F => UK /= %12 /= %13 /= %18 /= %1B
@BOX 4.1
;IF REDUCE.EXPR(REC) & %340F /= 3
@BOX 5.1
;(IF  AS[U] & %200 = 0 THEN %21 ELSE %22) => A.FN
;1 => IFILE
;PL.STK.LB (FIO.SELECT.STRING,0)
@BOX 6.1
;IF E.T & %F = 5
@BOX 8.1
;IF UK /= %13
@BOX 9.1
;SET.A.TYPE(ET!%48,AS[U]->>5&7)
;CODE.SUBSCRIPTS (AS[U+2],AS[U+4],0)
;TL.PL(A.FN!%40,AS[U+1])
;TL.PL(%64,0)
;TL.PL(%22,%1004)
@BOX 10.1
;TL.PL(%45,%83)
@BOX 11.1
;CODE.EXPR(REC,%102)
@BOX 12.1
;TL.PL(%27,0)
;TL.PL(%41,%3000)
;-1 => CUR.A.TYPE.G
@BOX 13.1
::END
@BOX 14.1
;FAULT(72,1)
@BOX 15.1
;FAULT(163,6)
@BOX 16.1
;SET.A.TYPE(6,0)
;PL.LOAD.STR(%61,U)
@BOX 17.1
;SET.A.TYPE(ET!8,AS[U]->>5&7)
;TL.PL(A.FN,AS[U+1])
@END
@TITLE FTN09.3.2(1,11)
@COL 36N-15R-16T-17R-11T-12R-13R
@COL 1S-2T-3T-4T-19T-5T-24T-20T-31T-32R-33R-7R-8N-26R-9N-10F
@COL 21T-14R-22R-25R-23R-34R-35N
@ROW 36-3-21
@ROW 24-15
@ROW 20-25
@ROW 32-34
@ROW 13-9
@FLOW 1-2N-3N-4N-19N-5N-24N-20N-31N-32-33-7-8-26-9-10
@FLOW 31Y-34-33
@FLOW 2Y-21N-14-7
@FLOW 3Y-36-11N-12-7
@FLOW 11Y-13-9
@FLOW 24Y-25-33
@FLOW 4Y-16N-17-8
@FLOW 16Y-9
@FLOW 5Y-15-7
@FLOW 21Y-22-9
@FLOW 20Y-23-9
@FLOW 19Y-9
@BOX 1.0
SELECT.FORMAT
@BOX 2.0
FORMAT ABSENT
@BOX 3.0
FORMAT = '*'?
@BOX 4.0
FORMAT AN INTEGER?
@BOX 5.0
FORMAT A VARIABLE OF
TYPE INTEGER SCALAR?
@BOX 24.0
FORMAT AN ARRAY NAME OF
ARITHMETIC  TYPE?
@BOX 25.0
ISSUE NON-STANDARD WARNING
PLANT CODE TO CREATE
BYTE VECTOR TO ARRAY
@BOX 31.0
CHAR EXPR?
@BOX 32.0
PL LOAD REF TO CHAR ITEM
:11.12
@BOX 33.0
PLANT STACKLINK TO
PROCESS FORMAT AT RUN TIME
STACK A
PLANT ENTER
@BOX 34.0
CREATE A DUMP FOR EXPR
AND COPY INTO IT:11.19
LOAD REF TO DUMP
@BOX 7.0
PLANT NIL PARAMS
@BOX 10.0
END
@BOX 11.0
INTERNAL FILE
OR REC PRESENT
@BOX 12.0
SET REQ MODE TO 2
@BOX 13.0
FAULT
@BOX 14.0
SET REQUIRED MODE TO 1
@BOX 15.0
PLANT CODE TO SELECT
FORMAT INDEX :11.22:
@BOX 16.0
CHECK LABEL CONTEXT
FAULTY?
@BOX 17.0
STACK FMT TABLE PTRS
@BOX 19.0
REDUCE.EXPR:11.2:
INVALID
@BOX 20.0
NOT A VALID CHAR ITEM
@BOX 26.0
PLANT STACK MODE
@BOX 21.0
INTERNAL UNIT?
@BOX 22.0
FAULT
@BOX 23.0
FAULT
@BOX 1.1
@BOX 2.1
;IF AS[AP+2] => FMT < 0
@BOX 3.1
;IF FMT = 0
@BOX 4.1
;IF AS[FMT] & %701F = %3010
@BOX 19.1
;IF REDUCE.EXPR(FMT) => ET = -1
@BOX 5.1
;IF AS[FMT]=>FMT0 & %FD1F = %3012
@BOX 20.1
;IF ET & %300F /= 5
@BOX 33.1
;PL.STK.LB(FIO.R.FORMAT,0)
;TL.PL(%41,%3000)
;TL.PL(%42,0)
@BOX 31.1
;IF AS[FMT] & %10 = 0
@BOX 32.1
;SET.A.TYPE(6,0)
;PL.LOAD.STR(%61,FMT)
@BOX 34.1
;IF CREATE.CHAR.EXPR.DUMP(FMT)
            =>T > 0 THEN
  ;TL.PL(%61,T)
;FI
@BOX 7.1
;TL.PL(%46,FMT.TABLE.PTR.TYPE.L)
;TL.C.NULL(FMT.TABLE.PTR.TYPE.L)
;TL.PL(%22,0)
;TL.PL(%41,%3000)
;TL.PL(%46,%83)
; -1 => CUR.A.TYPE.G
;TL.C.NULL(%83)
;TL.PL(%22,0)
;TL.PL(%41,%3000)
@BOX 26.1
;PL.STK.PAR(UNIT.FL!IO)
@BOX 11.1
;IF IFILE /= 0 OR REC >= 0
@BOX 12.1
; 2 !> UNIT.FL
@BOX 13.1
;FAULT(76,1)
@BOX 14.1
; 1 !> UNIT.FL
@BOX 21.1
;IF IFILE /= 0
@BOX 22.1
;FAULT(74,1)
@BOX 23.1
;FAULT(75,1)
@BOX 24.1
;IF FMT0 & %F = 8 AND
    FMT0 ->> 12 =>T /= 5
@BOX 25.1
;FAULT(170,6)
;TL.PL(%46, MUTL.TYPE(T, FMT0 ->> 5 & 7) ! 3)
;IF FMT0 & %200 /= 0  THEN
  ;%22=>T
;ELSE
  ;%21=>T
;FI
;TL.PL(T,AS[FMT+1])
;TL.PL(%45, %83)
; -1 => CUR.A.TYPE.G
@BOX 15.1
;PL.STK.LB(FIO.SELECT.FORMAT,0)
;IF FMT.DICT.NAME.G = 0 THEN
     TL.S.DECL(NIL.STR,FMT.DICT.TYPE.G,-1)
     ; MUTLN.G => FMT.DICT.NAME.G +1
      => MUTLN.G
 FI
;TL.PL(%46,FMT.DICT.TYPE.G <<-2 + 259)
;TL.PL(%21,FMT.DICT.NAME.G)
;TL.PL(%41,%3000)
; -1 => CUR.A.TYPE.G
; SET.A.TYPE(3,1)
;TL.PL(%22,AS[FMT+1])
;TL.PL(%41,%3000)
;TL.PL(%42,0)
@BOX 16.1
;CONST OF PROPS.T[AS[FMT+2]] => CP
;IF PROCESS.STAT.REF(4,INT.CONST OF CP^=>L)
       => SP = NIL.SP
@BOX 17.1
;TL.PL(%46,FMT.TABLE.PTR.TYPE.L)
; TL.PL(%21,S.TL.NAME OF SP^ => T)
; TL.PL(%41,%3000)
;TL.PL(%46,%83)
; -1 => CUR.A.TYPE.G
; TL.PL(%21,T+1)
; TL.PL(%41,%3000)
@END
@TITLE FTN09.3.3(1,6)
@COL 9N-10R-11N
@COL 1S-2R-3N-4T-5R-7T-8F
@ROW 9-3
@ROW 10-5
@ROW 11-7
@FLOW 1-2-3-4NO-5-7NO-8
@FLOW 4YES-10-7
@FLOW 7YES-11-9-3
@BOX 1.0
PROC CODE IO LIST(AR PTR)
@BOX 2.0
ROUTINES
CODE LIST EL:9.3.4:
@BOX 4.0
DO IMPLIED LIST?
@BOX 5.0
CODE R/W FOR ELEMENT FROM IOLIST
:9.3.4:
@BOX 7.0
ADVANCE TO NEXT LIST ELEMENT
ANY MORE ELEMENTS?
@BOX 8.0
END
@BOX 10.0
CODE DO IMP LIST
:9.3.3.1:
@BOX 1.1
;PROC CODE.IO.LIST(AP)
;$IN P, IOLAP, AP1
;0=>P
@BOX 2.1
#FTN09.3.4
@BOX 4.1
;IF AS[AS[AP]=>AP1] => P = 0
@BOX 5.1
;CODE.IO.LIST.EL(P)
@BOX 7.1
;IF AS[1+>AP] /= -1
@BOX 8.1
;END
@BOX 10.1
#FTN09.3.3.1
@END
@TITLE FTN09.3.3.1(1,10)
@COL 1S-2R-4R-5R-7T-8R-9R-10F
@FLOW 1-2-4-5-7NO-8-9-10
@FLOW 7YES-9
@BOX 1.0
DO IMPLIED LIST
@BOX 2.0
REMEMBER START OF IOLIST
@BOX 4.0
ALLOCATE A DO IMPLIED LABEL AND
INSERT IN A/R
@BOX 5.0
CODE DO LOOP:8.10:
@BOX 7.0
NO IOLIST?
@BOX 8.0
CODE IOLIST:9.3.3:
@BOX 9.0
CODE END OF DO LOOP:8.22:
@BOX 10.0
END
@BOX 1.1
@BOX 2.1
;AS[AP1+1] => IOLAP
@BOX 4.1
;1+>CUR.DO.IMPLIED.LABEL.G => INT OF PROPS.T[1+>PROPS.I]
;PROPS.I => AS[AP1+1=>STAT.AP.G]
@BOX 5.1
;F.DO()
@BOX 7.1
;IF AS[IOLAP] = -1
@BOX 8.1
;CODE.IO.LIST(IOLAP)
@BOX 9.1
;DO.LABEL(CUR.DO.IMPLIED.LABEL.G)
;1-> CUR.DO.IMPLIED.LABEL.G
@BOX 10.1
@END
@TITLE FTN09.3.4(1,11)
@COL 28R-31T-32T-33R-34R
@COL 1S-9T-3R-38R-39R-4T-5T-6T-7R-27T-8T-11R-12R-13T-16R-17R-2F
@COL 18T-19R-20R-21R-35T-22T-36T-37R-24T-25T-26R-23R
@ROW 4-18
@FLOW 1-9N-3-38-39-4NO-5NO-6NO-7-27N-8NO-11-12-13NO-16-17-2
@FLOW 9Y-17
@FLOW 4YES-18N-19-17
@FLOW 5YES-20-6
@FLOW 6YES-21-17
@FLOW 8Y-31N-32N-33-12
@FLOW 31Y-12
@FLOW 32Y-34-12
@FLOW 13YES-17
@FLOW 18YES-35N-22N-36Y-24N-25N-26-12
@FLOW 36N-37-12
@FLOW 35Y-7
@FLOW 22Y-23-17
@ROW 28-27
@FLOW 27Y-28-12
@FLOW 24Y-11
@FLOW 25Y-17
@BOX 1.0
CODE IOLISTEL(AR PTR)
@BOX 3.0
REDUCE EXPR:11.2:
GET ITS TYPE
AND EXPR PRECISION
@BOX 4.0
NOT ARRAY EL, NOT SUBSTRING
NOT ARRAY AND NOT SCALAR?
@BOX 5.0
READING TO A DO VAR?
@BOX 6.0
ARRAY WITH NO SUBSCRIPTS?
@BOX 7.0
PLANT STACK LINK:11.22:
@BOX 8.0
READ OR COMPLEX?
@BOX 9.0
REDUCE EXPR :11.2:
IS IT FAULTY?
@BOX 11.0
CODE EXPR:11.3:
PLANT CONV IF NECESSARY
PLANT STACK A
@BOX 12.0
PLANT ENTER
@BOX 13.0
WRITE OR LIST DIRECTED OR
CHAR OR COMPLEX?
@BOX 16.0
PLANT  A CONV IF NECESSARY
PLANT STORE TO ITEM:11.13:
@BOX 17.0
RESET A AND B USE INFO
@BOX 2.0
END
@BOX 18.0
NOT READING?
@BOX 19.0
FAULT
@BOX 20.0
FAULT
@BOX 21.0
CODE R/W ARRAY:9.3.4.1:
@BOX 22.0
INVALID EXPR?
@BOX 23.0
FAULT
@BOX 27.0
CHAR?
@BOX 28.0
CODE EXPR A =
PLANT STACK A WITH BOUND
@BOX 24.0
NON CHAR EXPR?
@BOX 25.0
CREATE CHAR EXPR DUMP:11.19:
FAULTY?
@BOX 26.0
PLANT STACK REF
@BOX 31.0
NOT LIST DIRECTED
NOR COMPLEX?
@BOX 32.0
ARRAY EL?
@BOX 33.0
PLANT A = REF
STACK A
@BOX 34.0
CODE SUBSCRIPTS:11.4:
PLANT D = REF OR D =
PLANT SEL EL
LOAD A
STACK A
@BOX 35.0
CONSTANT OR FN REFN
AND NOT COMPLEX?
@BOX 36.0
NOT COMPLEX?
@BOX 37.0
CODE EXPR:11.3:
DECLARE COMPLEX DUMP
PLANT A=>DUMP
PLANT A=REF DUMP
PLANT STACK A
@BOX 38.0
SET REQUIRED PRECISION [FTN09.3.4.2]U
@BOX 39.0
SELECT APPR R/W PROC
@BOX 1.1
;PSPEC CODE.IO.LIST.EL($IN)
;PROC CODE.IO.LIST.EL(AP)
;$IN IT,DIM.INFO,IK,T,AIT,PR,R,W0,RW.PR
;$IN LS,DIM,N,I,LIT.BOUND,FN,L
;ADDR LOCAL.PROP LP
;LITERAL/ADDR [$LO8] NILSTR=
;ADDR [$IN] ARR
;$IN DFN, AFN
@BOX 3.1
;AIT & %F => IT
;IF IT = 7 THEN
   ;5 => IT
   ;AS[AP] & %0F1F ! %5000 => AS[AP]
;FI
;IF IT > 5 THEN
   ;0 => IT
;FI
;IF AS[AP] & %200 /= 0 THEN
  ;%62=>DFN
;ELSE
  ;%61=>DFN
;FI
;AS[AP] => W0 & %1F => IK
@BOX 4.1
;IF  IK /= %12
 /= %13 /= %18 /= %1F
@BOX 5.1
;LOC OF PROPS.T[AS[AP+2]] => LP
;IF LSPECS OF LP^ & %400 /= 0
     AND IO = 4
@BOX 6.1
;IF IK = %18
@BOX 8.1
;IF IO = 4 OR IT = 2
@BOX 9.1
;IF REDUCE.EXPR(AP) => AIT = -1
@BOX 11.1
;CODE.EXPR(AP,%22)
;IF RW.PR /= PR THEN
   ;SET.A.TYPE(%10 ! IT, RW.PR)
;FI
;TL.PL(%41,%3000)
@BOX 7.1
;PL.STK.LB(R,RW.RES[R])
@BOX 12.1
;TL.PL(%42,0)
@BOX 13.1
;IF IO /= 4 OR FMT = 0 OR IT = 5
    OR IT = 2
@BOX 16.1
;IF RW.PR /= PR THEN
   ;SET.A.TYPE(%10 ! IT, PR)
;FI
;PLARITHFN(%20,AP)
;IT=>CUR.A.TYPE.G
@BOX 18.1
;IF IO /= 4
@BOX 19.1
;FAULT(77,1)
@BOX 20.1
;LP => F.L.PROP.G
;FAULT(334,1)
@BOX 21.1
#FTN09.3.4.1
@BOX 22.1
;IF AIT & %3000 /= 0
@BOX 23.1
;FAULT(79,1)
@BOX 17.1
;-1 => A.AP.G => B.AP.G
@BOX 2.1
;END
@BOX 27.1
;IF IT = 5
@BOX 28.1
;SET.A.TYPE(6,0)
;CODE.EXPR(AP,%21)
;TL.PL(%41,%3000)
@BOX 24.1
;IF IT /= 5
@BOX 25.1
;IF CREATE.CHAR.EXPR.DUMP(AP)=>N < 0
@BOX 31.1
;IF FMT /= 0 AND IT /= 2
@BOX 32.1
;IF IK = %13
@BOX 33.1
;SET.A.TYPE(IT!8, RW.PR)
;TL.PL(DFN-%40,AS[AP+1])
;TL.PL(%41,%3000)
@BOX 34.1
;CODE.SUBSCRIPTS(AS[AP+2],AS[AP+4],0)
;TL.PL(DFN,AS[AP+1])
;TL.PL(%64,0)
; SET.A.TYPE(IT!8, RW.PR)
;TL.PL(%21,%1004)
;TL.PL(%41,%3000)
@BOX 35.1
;IF [IK = %10 OR IK =  %14
      OR IK =  %16]
    AND IT /= 2
@BOX 26.1
;SET.A.TYPE(6, 0)
;TL.PL(%21,N)
;TL.PL(%41,%3000)
@BOX 36.1
;PL.STK.LB(R, RW.RES[R])
;IF IT /= 2
@BOX 37.1
;CODE.EXPR(AP,%22)
;TL.S.DECL(NIL.STR,%108,0)
;MUTL.NG=>N+1=>MUTL.NG
;TL.PL(%20,N)
;SET.A.TYPE(10, 3)
;TL.PL(%21,N)
;TL.PL(%41,%3000)
@BOX 38.1
#FTN09.3.4.2
@BOX 39.1
;RW.PROC.SET + RW.POS[IT] => R
;IF IT = 3 OR IT = 4 THEN
   ;RW.PR +> R
;FI
@END
@TITLE FTN09.3.4.1(1,11)
@COL 1S-16R-3T-2T-4R-5R-6R-10T-11R-12R-13F
@COL 15R-14R-23N
@ROW 12-23
@ROW 3-15
@ROW 4-14
@FLOW 1-16-3N-2N-4-5-6-10N-11-12-13
@FLOW 2Y-14-5
@FLOW 3Y-15-23-13
@FLOW 10Y-12
@BOX 1.0
CODE ARRAY
@BOX 16.0
DECLARE LOOP VAR
UNLESS ONE IS ALREADY ALLOCATED
@BOX 2.0
GET ARRAY SPEC
NOTE NO OF DIMS
ARRAY BOUND CONSTANT?
@BOX 3.0
ASSUMED SIZE ARRAY?
@BOX 4.0
DECLARE VARIABLE FOR DYNAMIC BOUND
PLANT CODE TO CALCULATE BOUND
@BOX 5.0
PLANT 0 => CNT
@BOX 6.0
PLANT LOOP START
PLANT CALL TO APPR R/W PROC:9.3.4.1.1:
@BOX 10.0
WRITE OR CHAR OR
COMPLEX OR LIST DIRECTED?
@BOX 11.0
PLANT B = CNT
CONVERT ACC IF NECESSARY
PLANT ACC => ITEM
@BOX 12.0
PLANT LOOP END
@BOX 13.0
END
@BOX 14.0
CALCULATE AND
DECLARE LITERAL BOUND
@BOX 15.0
FAULT
@BOX 1.1
@BOX 16.1
;IF RW.ARR.CNT.VAR.G = 0 THEN
  ;TL.S.DECL(NIL.STR,I.ACC.T.L,0)
  ;MUTL.N.G=>RW.ARR.CNT.VAR.G+1=>MUTL.N.G
;FI
@BOX 2.1
;MUTL.N.G => N
;L.ARR.SPEC.P OF LP^ => ARR
;ARR^[0] => DIM
;IF LS & %200 = 0 THEN
       ;%61 => D.FN
;ELSE
       ;%62 => D.FN
;FI
;IF LS & %8000 = 0
@BOX 3.1
;IF L.SPECS OF LP^ => LS & %100 /= 0
@BOX 4.1
;TL.S.DECL(NIL.STR,I.ACC.T.L,0)
::MULT.NAME INCR IN BOX 5
;4 => I
;1 => LIT.BOUND
;SET.A.TYPE(3,2)
;%22 => FN
;ARR^[1] => DIM.INFO
;WHILE 1->DIM >= 0 DO
     ;IF DIM.INFO ->> 2 => DIM.INFO & 3 = 0 THEN
           ;ARR^[I] *> LIT.BOUND
     ;ELSE
           ;TL.PL(FN,ARR^[I])
           ;%2B => FN
     ;FI
     ;3 +> I
;OD
;IF LIT.BOUND /= 1 THEN
     ;TL.C.LIT.32(I.ACC.T.L,LIT.BOUND)
     ;TL.PL(%2B,0)
;FI
;TL.PL(%20,N)
@BOX 14.1
;1 => I; 1 => LIT.BOUND
;WHILE 1->DIM >= 0 DO
     ;ARR^[3+>I] *> LIT.BOUND
;OD
;TL.C.LIT.32(I.ACC.T.L,LIT.BOUND)
;TL.LIT(NIL.STR,0)
@BOX 5.1
;1 +> MUTL.N.G
;SET.A.TYPE(3,2)
;TL.PL(%22,TL.ZERO.G)
;TL.PL(%20,RW.ARR.CNT.VAR.G)
@BOX 6.1
;TL.CV.CYCLE(RW.ARR.CNT.VAR.G,TL.ZERO.G,0)
;TL.CV.LIMIT(N)
#FTN09.3.4.1.1
@BOX 10.1
;IF IO /= 4 OR IT = 5 OR IT = 2 OR FMT  = 0
@BOX 11.1
;TL.PL(%2,RW.ARR.CNT.VAR.G)
;TL.PL(DFN,L.TL.NAME OF LP^)
;TL.PL(%64,0)
;IF RW.PR /= PR THEN
    SET.A.TYPE(%10!IT,PR) FI
;TL.PL(%20,%1004)
@BOX 12.1
;TL.REPEAT()
@BOX 13.1
@BOX 15.1
;LP=>F.L.PROP.G
;FAULT(80,1)
@END
@TITLE FTN09.3.4.1.1(1,11)
@COL 21R
@COL 6S-7T-8R-18T-19T-20R-9R-2R-10F
@COL 22R
@ROW 21-20-22
@FLOW 6-7N-8-18N-19N-20-9-2-10
@FLOW 18Y-21-9
@FLOW 19Y-22-9
@FLOW 7Y-2
@BOX 2.0
PLANT ENTER
@BOX 6.0
PLANT STACKLINK TO APPR R/W PROC:11.22:
@BOX 7.0
READ AND NOT CHAR AND
NOT COMPLEX AND
NOT LIST DIRECTED?
@BOX 8.0
SET.B.TYPE
PLANT B = CNT
@BOX 18.0
CHAR ARRAY?
@BOX 19.0
LIST DIRECTED
READ OR COMPLEX?
@BOX 20.0
SET A TYPE
@BOX 21.0
LOAD A WITH ARRAY EL
REFN:11.21
@BOX 22.0
SET A TYPE
@BOX 9.0
STACK A
@BOX 10.0
END
@BOX 2.1
;TL.PL (%42, 0)
@BOX 6.1
;PL.STK.LB(R,RW.RES[R])
@BOX 7.1
;IF IO = 4 AND IT /= 5 AND IT /= 2 AND FMT /= 0
@BOX 8.1
;SET.B.TYPE(2)
;TL.PL(%2,RW.ARR.CNT.VAR.G)
@BOX 18.1
;%21 => AFN
;IF IT = 5
@BOX 19.1
;TL.PL(DFN,L.TL.NAME OF LP^)
;TL.PL(%64,0)
;IF IO = 4 AND FMT =< 0 OR IT = 2
@BOX 20.1
;%22 => AFN
;SET.A.TYPE(IT,RW.PR)
@BOX 21.1
;LOAD.REGS.FOR.CHAR.ARRAY.EL.REFN(LP)
;TL.PL(%66,STR.ARR.BASE.OP.L)
;IF L.LEN OF LP^ => T >=  0THEN
  ;TL.C.LIT.32(I.ACC.T.L,T-1)
  ;TL.PL(2,0)
;ELSE
  ;TL.PL(2,0-T)
  ;TL.PL(9,TL.ONE.G)
;FI
;TL.PL(%67,0)
;SET.A.TYPE(6,0)
@BOX 22.1
;SET.A.TYPE(IT!8,RW.PR)
@BOX 9.1
;TL.PL(AFN,%1004)
;TL.PL(%41,%3000)
@END
@TITLE FTN09.3.4.2(1,11)
@COL 10R
@COL 1S-2R-3T-5T-6T-7T-8R-12R-9F
@COL 11R
@ROW 10-8-11
@FLOW 1-2-3N-5N-6N-7N-8-12-9
@FLOW 5Y-10-12
@FLOW 3Y-11-12
@FLOW 6Y-11
@FLOW 7Y-11
@BOX 1.0
SET PRECISION
@BOX 2.0
GET EXPR PRECISION
@BOX 3.0
EXPR TYPE NOT INT/LOGICAL
@BOX 5.0
LIST DIRECTED OUTPUT
@BOX 6.0
EXPR NOT A CONSTANT
OR AN EXPRESSION?
@BOX 7.0
PRECISION > DEFAULT
@BOX 8.0
SET REQUIRED PRECISION
TO DEFAULT
@BOX 12.0
SELECT AVAILABLE PRECISION
@BOX 10.0
SET REQUIRED PRECISION
TO 32 BITS
@BOX 11.0
SET REQUIRED PRECISION
TO EXPR PRECISION
@BOX 9.0
END
@BOX 1.1
:: FTN09.3.4.2
@BOX 2.1
; 0 => PR
; IF IT /= 5 THEN
     W0 ->> 5 & 7 => PR
    ;IF IK = %F THEN
        0 => PR
     FI
  FI
@BOX 3.1
;IF IT /= 3 /= 4
@BOX 5.1
;IF FMT = 0 AND IO = 8
@BOX 6.1
;IF W0 & %1F >= %12
@BOX 7.1
;IF PR >= I.ACC.Z.G
@BOX 8.1
;I.ACC.Z.G => RW.PR
@BOX 9.1
::END
@BOX 10.1
;2 => RW.PR
@BOX 11.1
;PR => RW.PR
@BOX 12.1
;F.PR.T[RW.PR] => RW.PR
@END
@TITLE FTN09.4(1,6)
@COL 1S-2T-3R-4F
@FLOW 1-2N-3-4
@FLOW 2Y-4
@BOX 1.0
DEFINE.RESTART(ERR,END)RESTART NAME
A ZERO RESULT INDICATE RESTART LABEL
NOT REQUIRED
@BOX 2.0
ALL PARAMS ABSENT?
@BOX 3.0
DECLARE LABEL
PLANT CALL TO
SET.FLT.RESTART:11.22:
@BOX 4.0
END
@BOX 1.1
;PROC DEFINE.RESTART(ER,EN)
;$IN T
;LITERAL/ADDR [$LO8] NIL.STR =
;0 => DEFINE.RESTART
@BOX 2.1
;IF ER + EN = -2
@BOX 3.1
;TL.LABEL.SPEC(NILSTR,3)
;MUTL.N.G => DEFINE.RESTART+1 => MUTL.N.G
;PL.STK.LB(FIO.SET.FLT.RESTART,0)
;0 => T
;IF ER >= 0 THEN
       ;1 => T
;FI
;IF EN >= 0 THEN
       ;2 !> T
;FI
;PL.STK.PAR(T)
;TL.PL(%46,%30)
;TL.PL(%21,DEFINE.RESTART)
;TL.PL(%41,%3000)
; -1 => CUR.A.TYPE.G
;TL.PL(%42,0)
@BOX 4.1
;END
@END
@TITLE FTN09.5(1,11)
@COL 1S-2T-13T-3R-4T-5R-6T-7R-8T-9R-10T-11R-12F
@COL 14R
@ROW 7-14
@FLOW 1-2N-13N-3-4N-5-6N-7-8N-9-10N-11-12
@FLOW 2Y-12
@FLOW 4Y-8
@FLOW 13Y-4
@FLOW 6Y-14-12
@FLOW 8Y-10
@FLOW 10Y-12
@BOX 1.0
PROCESS.FAULT(IOSTAT,ERR,END,RESTART.LABEL)
@BOX 2.0
ALL PARAMS ABSENT?
@BOX 13.0
NO RESTART LABEL REQUIRED?
@BOX 3.0
PLANT RESTART LABEL
@BOX 4.0
IOSTAT ABSENT?
@BOX 5.0
CONVERT DATA ITEM INTO EXPR:9.7:
@BOX 6.0
REDUCE.EXPR:11.1:
INVALID IOSTAT
@BOX 7.0
PLANT A = IOS WORD
PLANT A CONV IF NECESSARY
PLANT A => IOSTAT:11.13:
@BOX 8.0
ERR ABSENT?
@BOX 9.0
PLANT IF IOS WORD > 0, GO TO ERR
:8.20:
@BOX 10.0
END ABSENT?
@BOX 11.0
PLANT IF IOS WORD < 0, GO TO END
:8.20:
@BOX 12.0
END
@BOX 14.0
FAULT
@BOX 1.1
;PROC PROCESS.FAULT(IOS,ER,EN,R)
;PSPEC LOAD.IOS()
;PROC LOAD.IOS
;SET.A.TYPE(3,2)
;PL.STK.LB(FIO.STATUS,I.ACC.T.L)
;TL.PL(%42,0)
;END
;$IN AP,T
;ADDR LABEL.PROP LP
@BOX 2.1
;IF IOS+R < 0
@BOX 13.1
;IF R = 0
@BOX 3.1
;TL.LABEL(R)
@BOX 4.1
;IF IOS < 0
@BOX 5.1
;CONVERT.DATA.ITEM.TO.EXPR(IOS) => AP
@BOX 6.1
;IF REDUCE.EXPR(AP) & %743F /= 3
@BOX 7.1
;LOAD.IOS()
;IF AS[AP]->>5&7=>T/=2 THEN
    SET.A.TYPE(%13,T)
 FI
;PL.ARITH.FN(%20,AP)
@BOX 8.1
;IF ER < 0
@BOX 9.1
;LOAD.IOS()
;TL.PL(%2F,TL.ZERO.G)
;PROCESS.STAT.REF(2,INT OF PROPS.T[ER]) => LP
;TL.PL(%4E,S.TL.NAME OF LP^)
@BOX 10.1
;IF EN < 0
@BOX 11.1
;LOAD.IOS()
;TL.PL(%2F,TL.ZERO.G)
;PROCESS.STAT.REF(2,INT OF PROPS.T[EN]) => LP
;TL.PL(%4C,S.TL.NAME OF LP^)
@BOX 12.1
;END
@BOX 14.1
;AS[IOS] => F.L.PROP.ADDR.G
;FAULT(29,5)
@END
@TITLE FTN09.6(1,11)
@COL 1S-2T-3T-4R-5F
@COL 6R-7R
@ROW 3-6
@FLOW 1-2N-3N-4-5
@FLOW 2Y-6-5
@FLOW 3Y-7-5
@BOX 1.0
PLANT.UNIT.PARAM(AR EXPR INDEX)
@BOX 2.0
IS UNIT ABSENT?
@BOX 3.0
REDUCE.EXPR:11.1:
INVALID?
@BOX 4.0
CODE.EXPR:11.2: IN A
CONVERT MODE TO INT32 IF NECESSARY
PLANT STACK PAR A
RESET A AND B USE INFO
@BOX 5.0
END
@BOX 6.0
FAULT
@BOX 7.0
FAULT
@BOX 1.1
;PROC PLANT.UNIT.PARAM(AP)
@BOX 2.1
;IF AP < 0
@BOX 3.1
;IF REDUCE.EXPR(AP) & %700F /= 3
@BOX 4.1
;CODE.EXPR(AP,%22)
;IF AS[AP] & %E0 /= 4 THEN
    SET.A.TYPE(%13,2)
 FI
;TL.PL(%41,%3000)
;-1 => A.AP.G => B.AP.G
@BOX 5.1
;END
@BOX 6.1
;FAULT(71,1)
@BOX 7.1
;FAULT(81,1)
@END
@TITLE FTN09.7(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
CONVERT DATA ITEM TO EXPR
(AR INDEX TO DATA ITEM) AR INDEX TO EXPR
@BOX 2.0
CREATE AR OF EQUIVALENT EXPR
@BOX 3.0
END
@BOX 1.1
;PROC CONVERT.DATA.ITEM.TO.EXPR(AP)
;$IN P,T
@BOX 2.1
;%1F => AS[END.AP.G=>P=>CONVERT.DATA.ITEM.TO.EXPR]
;IF AS[AP+1] /= 0 THEN
      ;%41F => AS[P]; AS[AP+1] => AS[P+4]
;FI
;0 => AS[P+1]
;AS[AP] => AS[P+2]
;5 +> END.AP.G
@BOX 3.1
;END
@END

