@X @~
~L3 COUK1247
80
~V7 56 2 -5
~D10
~H                    MUSS
~
~
~D10
~H             FTN271
~D10
~MMANCHESTER UNIVERSITY  -  CONFIDENTIAL~
~
~
                                                                      ISSUE 11~
~V9 -1
~P
~V9 1
~YFTN271
~S1~M~OFORTRAN 77 I/O LIBRARY IMLEMENTATION DESCRIPTION
~S1~M~OSection 27~
~S1~OSection 27. Unit Control Procedures
~S1~O1.1 General Description
~BThe procedures in this section are used when selecting a unit for input/output
or auxiliary operations, and for handling error traps.
~S1~O1.2 Non Standard Features
~BSee section 25 for a description of pre-connected
unit/stream/file association.
~BFormats may be specified at run-time by using an array of
arithmetic type containing Hollerith data, as described in
Section 21 of the standard. This is an implementation dependent feature
currently storing up to four characters per arithmetic item.
~S1~O2. Interfaces
~S1~O2.1 Section Interfaces Used
~
   Section 21:   (Configuration Section)~
~S1~O2.2 Section Interface
~
Exported Types:~
   UNIT~
~
Exported Scalars~
   PW0,PW1,PW2,PW3,PW4,PW5,PW6,PWW1,PWW2,PWW3,PWW4~
   CUR.UNIT~
   CUR.FMT~
   OLD.TRAP~
   REST.REQ~
   IN.RES~
   BLK~
   LEN~
   REC~
   CCC~
   OLD.STATUS~
   POS.S~
   SLASH~
   FMT.TBL~
   CHAR.CONST.TBL~
   RESTART.LABEL~
~
Exported Vectors:~
   UNIT.TABLE~
~
Library Procedures:~
   FIO.SET.FLT.RESTART~
   FIO.SELECT.SEQ.UNIT~
   FIO.SELECT.DA.UNIT~
   FIO.SELECT.STRING~
   FIO.TRAP.RESTART~
   FIO.SET.UNIT.REC.L~
   FIO.R.FORMAT~
   FIO.SELECT.FORMAT~
   FIO.HOLL.FORMAT~
   FIO.STATUS~
   FIO.OUT.UNIT.TABLE~
~S1~O3. Implementation
~S1~O3.1 Outline of Operation
~S1~O3.1.1 FIO.SET.FLT.RESTART(IO.FLT.REQ,RESTART.ADDR)
~3
~
~
   P1 - IO.FLT.REQ   - specifies class of faults to be returned~
                       to user program.~
           bit 0 - 1   Error conditions~
           bit 1 - 1   End of file conditions~
   P2 - RESTART.ADDR - user program restart address.~
~0
~BThis procedure enables fault conditions encountered during input/output
to be returned to user program level, by indicating a Fortran label as a
restart point for users in FIO.TRAP.RESTART.
~S1~O3.1.2 FIO.SELECT.SEQ.UNIT(UNIT,^FMT.TABLE,^FMT.STRINGS,MODE)
~3
~
~
   P1 - Unit Number.~
   P2 - Pointer to Format table.~
   P3 - Pointer to Format character table.~
   P4 - MODE~
        Bits  0-1 Only significant when P2 is nil.~
            = 0   Run-time format selected.~
            = 1   Unformatted I/O.~
            = 2   List-directed I/O.~
            = 3   Auxiliary I/O needing no format checking.~
        Bit 2 = 1 Input Unit.~
        Bit 3 = 1 Output Unit.~
        Bit 4 = 1 Ignore P1, and take default stream ('*').~
~0
~BThis procedure selects the appropriate stream for the specified
sequential access unit. A search is made of the unit table to locate
the unit, and when found its status and access are checked. If the
unit has changed from write to read or vice versa checks are made
to ensure an endfile is written and the status is valid. If the unit
has never been accessed the previously defined connection is made.
Finally the correct stream and specified format are selected.
~S1~O3.1.3 FIO.SELECT.DA.UNIT(UNIT,^FMT.TABEL,^FMT.STRINGS,MODE,REC.NO
~3
~
~
   P1 - UNIT number.~
   P2,P3,P4 - As 3.1.2 except list directed output not permitted.~
   P5 - REC.NO Record number.~
~0
~BThis procedure selects the appropriate stream for the specified
direct access unit. The unit able is searched to locate the unit, which
is checked for the correct access and status. If the unit has not
been access a connection is made before selecting the stream and
specified format.
~S1~O3.1.4 FIO.SELECT.STRING(STRING,^FMT.TABLE,^FMT.STRINGS,MODE)
~3
~
~
   P1 - STRING Descriptor to internal file storage area.~
   P2,P3,P4 - As 3.1.2.~
~0
~BThe procedure selects an internal file (i.e. a character
string) for input/output with
a format, on such files the access is sequential. The next record position
is the first record.
A check is made that the formatting is valid and then
a vacant stream is defined and selected for the operation.
~S1~O3.1.5 FIO.TRAP.RESTART(TRAP.NO,REASON)
~BThis procedure is called by the trapping mechanism, whenever a trap
is made. It examines the type of trap and decides if the Fortran Program
should be re-entered using the label specified to FIO.SET.FLT.RESTART,
otherwise the standard trap is entered.
~BA trap is entered for an exception condition unless a status
specifier for the exception condition was given in the input/output
statement.
~3
~S1~OTrap 6 Fault No's.~
~
~
101  Inconsistent field descriptor for input/output list item.~
102  Illegal character in list directed complex character.~
103  Illegal use of null value in list directed complex constant.~
104  Attempted read beyond end of record.~
105  No field descriptor for input/output list item.~
106  Illegal character in integer or exponent.~
107  Illegal value separator.~
108  Illegal use of repeat counts.~
109  Zero repeat count not allowed.~
110  As 104.~
111  Illegal character in logical item.~
112  Illegal character (in repeat count?).~
113  * missing from a repeat count.~
114  Illegal character in a real.~
115  Illegal sign in integer or exponent.~
116  Attempted write beyond end of record.~
117  Illegal carriage control char. on output.~
118  Illegal run time format.~
119  Format label specified not defined.~
120  No digit following sign.~
121  Read past sequential ENDFILE record.~
122  Illegal unit access.~
123  Invalid parameter in OPEN.~
124  Invalid parameter in CLOSE.~
125  Writing Direct Access record of wrong length.~
126  Writing beyond sequential ENDFILE record.~
127  Invalid unit number.~
128  Too many units connected.~
129  Invalid Fortran file format.~
130  Unimplemented I/O facility used.~
~0
~S1~OStatus Specifiers.~
~
~
Not yet defined.~
~S1~O3.1.6 FIO.SET.UNIT.REC.L(UNIT,LENGTH)
~BThis procedure alters the maximum record length for the specified
unit.
~S1~O3.1.7 FIO.R.FORMAT(STRING)
~BThis procedure is called to process a format at run-time. It calls
FIO.FORMAT, and selects the run-time format tables.
~S1~O3.1.8 FIO.SELECT.FORMAT(^FMT.DICT,LABEL)
~BThis procedure is called at run-time to select a format from the
format dictionary indicated by the label.
~S1~O3.1.9 FIO.HOLL.FORMAT(VECTOR)
~BThis procedure is called to process a format at run-time contained
in a vector of arithmetic type. It converts the arithmetic vector
to a character string before calling FIO.FORMAT and setting up the
run-time format tables.
~S1~O3.1.10 FIO.STATUS
~BThis procedure returns the value of the input/output status word.
~S1~O3.1.11 FIO.OUT.UNIT.TABLE
~BThis is a debugging procedure used for printing the contents
of the unit table.
~S1~O3.1.12  FIO.INIT.RUN()~
~BThis procedure initialises the library at the start of a
program run.~
~S1~O3.1.13  FIO.END.RUN()
~BThis procedure closes all units, except those units connected to
stream 0, and any preconnected units which have not been rewound.~
~S1~O3.2 Data Structures
~BThis section uses a unit table to define the connection between
a unit and a file using a stream. The structure of the unit table
as shown below:~
~3
~
  UNIT.NO          Fortran unit number of this entry~
  STREAM.NO        Stream number for this connection~
  STATUS           Bit encoded~
~
             Bit 0 - 1   Unit accessed~
                 1 - 0/1 Sequential/Direct access~
                 2 - 1   Input Unit~
                 3 - 1   Output Unit~
                 4 - 1   Unit Pre-connected~
                 5 - 1   Records formatted~
                 6 - 1   Records unformatted~
                 7 - 1   Endfile written to sequential Unit or~
                         just read~
                 8 - 0/1 Zero blank control is ZERO/NULL~
                 9 - 0/1 Unit closed/open~
                10 - 1   Last operation was a write~
           Bits 11 - 15  Number of bytes in FILE.NAME~
~
  RECORD.L         length in bytes~
  RECORD.NO        Number of record last accessed when direct~
                   access~
  FILE.NAME        17 bytes.~
~
~0
The currently selected unit is indicated by the unit table pointer
CUR.UNIT.~
~Y
~V9 -1
~P
~D15
~HFLOWCHARTS
~
~
~H                FTN271
~V9 -1
~F
@TITLE FTN27(1,11)
@COL 1S-2R-3R-4R-5R-6R-7R-9F
@FLOW 1-2-3-4-5-6-7-9
@BOX 1.0
UNIT CONTROL SECTION
@BOX 2.0
[IMPORTS FTN27/1]
MODULE HEADING
@BOX 3.0
TYPE DECLARATIONS
@BOX 4.0
LITERAL DECLARATIONS
@BOX 5.0
SCALAR DECLARATIONS
@BOX 6.0
VECTOR DECLARATIONS
@BOX 7.0
PROCEDURES IN MODULE
   FTN27.1:SET FLT RESTART
   FTN27.2:SELECT SEQ UNIT
   FTN27.3:SELECT DA UNIT
   FTN27.4:SELECT STRING
 ::FTN27.5CV:TRAP RESTART
   FTN27.5:TRAP RESTART
   FTN27.6:SET UNIT REC.L
   FTN27.7:R FORMAT
   FTN27.8:SELECT FORMAT
   FTN27.10:STATUS
   FTN27.11:OUT.UNIT.TABLE
   FTN27.12:INIT.RUN
   FTN27.13:END.RUN
COMMON PROCEDURES FOR ABOVE
   FTN27.20:SET REC INFO
@BOX 9.0
END
@BOX 2.1
#FTN27/1
;MODULE(UNIT,UNIT.TABLE,CUR.UNIT,FIO.SET.FLT.RESTART,FIO.SELECT.SEQ.UNIT,CUR.FMT
,
   FIO.SELECT.DA.UNIT,FIO.SELECT.STRING,FIO.TRAP.RESTART,
   FIO.SET.UNIT.REC.L,OLD.TRAP,OLD.STATUS,FMT.DICT.TYPE,
   FIO.R.FORMAT,FIO.SELECT.FORMAT,FIO.STATUS,FIO.OUT.UNIT.TABLE,
   FMT.TBL,CHAR.CONST.TBL,BLK,LEN,REC,POS.S,FIO.INIT.RUN,FIO.END.RUN,R.FMT.TBL,
   REST.REQ,SLASH,IN.RES,PW0,PW1,PW2,PW3,PW4,PW5,PW6,PWW0,PWW1,PWW2,PWW3,PWW4,
   T.POS,C.POS,S.POS,E.POS,EOR.POS,
   OIS,OOS,END.PROG,CONNECT.FILE);
@BOX 3.1
;TYPE UNIT IS
   $LO16 STATUS
   $IN32 RECORD.L,RECORD.NO,MAX.RECORD.POS,MAX.POS,UNIT.NO
   $IN16 STREAM.NO
;TYPE FMT.DICT.TYPE IS
   $LO16 FMT.ID
   ADDR [$IN16] FMT.TBL.PTR
   ADDR [$LO8] FMT.CHAR.PTR
@BOX 4.1
;LITERAL/ADDR [$IN16] NIL.TBL =
;LITERAL/ADDR UNIT NIL =
;LITERAL/ADDR [$LO8] VOID =
; *GLOBAL 0
@BOX 5.1
; *GLOBAL 12
; ADDR PW0,PW1,PW2,PW3,PW4,PW5,PW6
; $LO64 PWW1,PWW2,PWW3,PWW4
;*GLOBAL 5
;ADDR UNIT CUR.UNIT
;$IN CUR.FMT,BLK,REC,POS.S,CCC,SLASH,OOS,OIS
;$IN32 S.POS,T.POS,E.POS,C.POS,EOR.POS
;ADDR [$IN16] FMT.TBL
;ADDR [$LO8] CHAR.CONST.TBL
;LABEL RESTART.LABEL,END.PROG
; UNIT IN.RES
;$IN REST.REQ
@BOX 6.1
;UNIT [UNIT.TABLE.SZ.L] UNIT.TABLE
;$IN16[R.FMT.LIMIT] R.FMT.TBL
;$LO8 [R.CHAR.LIMIT] R.CHAR.TBL
; *GLOBAL 0
@BOX 7.1
;L.SPEC FIO.SET.FLT.RESTART($IN16,LABEL)
;L.SPEC FIO.SELECT.SEQ.UNIT($IN32,ADDR[$IN16],ADDR[$LO8],$IN16)
;L.SPEC FIO.SELECT.DA.UNIT($IN32,ADDR[$IN16],ADDR[$LO8],$IN16,$IN32)
;L.SPEC FIO.SELECT.STRING(ADDR[$LO8],$IN32,$IN32,ADDR[$IN16],ADDR[$LO8],$IN16)
;L.SPEC FIO.SET.UNIT.REC.L($IN32,$IN32)
;L.SPEC FIO.R.FORMAT(ADDR[$LO8])
;L.SPEC FIO.SELECT.FORMAT(ADDR[FMT.DICT.TYPE],$IN16)
;L.SPEC FIO.STATUS()/$IN32
;L.SPEC FIO.OUT.UNIT.TABLE()
;L.SPEC FIO.INIT.RUN(LABEL)
;L.SPEC FIO.END.RUN()
;P.SPEC CONNECT.FILE(ADDR [$LO8])/$IN
;P.SPEC SET.REC.INFO(ADDR[$IN16],ADDR[$LO8],$IN16)
#FTN27.1
#FTN27.2
#FTN27.3
#FTN27.4
::CV-OPTION#FTN27.5CV
#FTN27.5
#FTN27.6
#FTN27.7
#FTN27.8
#FTN27.10
#FTN27.11
#FTN27.12
#FTN27.13
#FTN27.20
@BOX 9.1
;*END
@END
@TITLE FTN27/1(1,11)
@COL 1S-3R-5R-6R-7F
@FLOW 1-3-5-6-7
@BOX 1.0
UNIT CONTROL IMPORTS
@BOX 3.0
IMPORTED LITERALS
@BOX 5.0
IMPORTED VECTORS
@BOX 6.0
IMPORTED PROCEDURES
@BOX 7.0
END
@BOX 3.1
;IMPORT LITERAL BYTE.PER.S.L,R.FMT.LIMIT,R.CHAR.LIMIT,NO.OF.TRAPS
;IMPORT LITERAL $LO8 SPACE.L
;IMPORT LITERAL UNIT.TABLE.SZ.L,STR0.IN.L,STR0.OUT.L,DATA.SEG
;IMPORT LITERAL $IN32 DATA.SEG.Z, MAX.SECTION.Z.L
;IMPORT LITERAL REC.HDR.Z
@BOX 5.1
; $IN16 [8] LD.FMT.TBL
@BOX 6.1
;L.SPEC FINDN(ADDR[$LO8],$IN)/$LO32
;L.SPEC CREATE.SEGMENT($IN,ADDR)
;L.SPEC RELEASE.SEGMENT($IN)
;L.SPEC OUTHEX($LO32,$IN)
;L.SPEC OUTCH($IN)
;L.SPEC NEWLINES($IN)
;L.SPEC OUTI($IN32,$IN)
;L.SPEC CAPTION($AD[$LO8])
;TYPE UNIT;
;P.SPEC FIO.FILENAME(ADDR UNIT,ADDR[$LO8])/ADDR[$LO8]
;P.SPEC FIO.FORMAT(ADDR[$LO8],ADDR[$IN16],ADDR[$LO8],$IN,$IN)/$IN
;P.SPEC FIO.SEARCH.UNIT.TABLE($IN32,$LO8)/ADDR UNIT
;L.SPEC ENTER.TRAP($IN,$IN)
;L.SPEC DEFINE.STRING.IO($IN,ADDR[$LO8],$IN32)/$IN
;L.SPEC SELECT.OUTPUT($IN)
;L.SPEC SELECT.INPUT($IN)
;L.SPEC DEFINE.INPUT($IN,ADDR[$LO8],$IN32)/$IN
;P.SPEC FIO.MARK.EOF()
;L.SPEC IN.REC()/$IN32
;L.SPEC CURRENT.INPUT()/$IN
;L.SPEC CURRENT.OUTPUT()/$IN
::CV ;L.SPEC TRANSLATE.LOGICAL.NAME(ADDR[$LO8],ADDR[$LO8])/ADDR[$LO8]
;P.SPEC FIO.CLOSE($IN32,ADDR[$LO8])
::CV ;L.SPEC READ.FILE.STATUS(ADDR[$LO8])
::MU ;L.SPEC READ.FILE.STATUS(ADDR[$LO8],$LO64)
;L.SPEC SET.O.REC($IN32)
;L.SPEC I.REC()/$IN32
;L.SPEC I.POS()/$IN32
;L.SPEC O.POS()/$IN32
;L.SPEC SET.O.POS($IN32)
@END
@TITLE FTN27.1(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
SET.FLT.RESTART(IO.FLT.REQ,RESTART.ADDR)
@BOX 2.0
SAVE
FLT.REQ
RESTART
ADDRESS
@BOX 3.0
END
@BOX 1.1
; PROC FIO.SET.FLT.RESTART(REQ,REST.ADDR)
@BOX 2.1
; REQ !> REST.REQ
; REST.ADDR => RESTART.LABEL
@BOX 3.1
END
@END
@TITLE FTN27.2(1,11)
@COL 42R-12R-9R-7R-4R
@COL 1S-36R-43T-3T-18R-2T-46R-5T-10T-21T-22R-16R-17F
@COL 20T-14R-24T-26R-19R
@ROW 10-20
@ROW 7-16
@ROW 42-3
@FLOW 1-36-43N-3N-18-2N-46-5N-10N-21N-22-16-17
@FLOW 21Y-16
@FLOW 43Y-42-4
@FLOW 5Y-20N-14-24N-26-17
@FLOW 3Y-12-4
@FLOW 10Y-7-4-17
@FLOW 20Y-19
@FLOW 24Y-17
@FLOW 2Y-9-4
@BOX 1.0
SELECT.SEQ.UNIT
     (UNIT,FMT.TBL.PTR,FMT.CHAR.PTR,MODE)
@BOX 42.0
FAULT 127
'INVALID UNIT NUMBER'
@BOX 36.0
SEARCH UNIT TABLE
FOR UNIT NUMBER
@BOX 43.0
NOT FOUND ?
@BOX 18.0
SET UP RECORD INFO
:27.20:
@BOX 2.0
UNIT NOT OPEN FOR
REQUIRED ACCESS?
@BOX 3.0
D.A. UNIT ?
@BOX 4.0
ENTER TRAP
@BOX 46.0
SELECT INPUT AND OUTPUT STREAMS
@BOX 9.0
FAULT 130
'UNIMPLEMENTED'
@BOX 10.0
AT ENDFILE ?
@BOX 7.0
FAULT 6,1
'READING PAST ENDFILE'
@BOX 5.0
NOT INPUT?
@BOX 12.0
FAULT 122
'WRONG TYPE
OF UNIT ACCESS'
@BOX 20.0
ENDFILE JUST WRITTEN ?
@BOX 19.0
FAULT 126
'WRITING AFTER ENDFILE'
@BOX 14.0
SET UP RECORD
@BOX 21.0
LAST OP NOT A WRITE
@BOX 22.0
WRITE END OF FILE
CLEAR ENDFILE
@BOX 24.0
NOT LIST DIR ?
@BOX 26.0
OUTPUT SPACE
@BOX 16.0
SET UP RECORD
@BOX 17.0
END
@BOX 1.1
; PROC FIO.SELECT.SEQ.UNIT
     (UNIT.ID,FMT.TBL.PTR,CHAR.TBL.PTR,MODE)
;$IN I,S,F
;ADDR UNIT CUR
@BOX 36.1
; FIO.SEARCH.UNIT.TABLE(UNIT.ID,%1C & MODE) => CUR
@BOX 43.1
;SELECT CUR^
; IF STATUS => S & %200 = 0
@BOX 18.1
; SET.REC.INFO(FMT.TBL.PTR, CHAR.TBL.PTR, MODE)
@BOX 2.1
; IF  %C &> MODE & S = 0
@BOX 3.1
; IF S & 2 /= 0
@BOX 4.1
;ENTER.TRAP(6,F)
@BOX 46.1
;SELECT.INPUT(STREAM.NO)
;SELECT.OUTPUT(STREAM.NO)
@BOX 9.1
; 130 => F
@BOX 10.1
; IF STATUS & %80 /= 0
@BOX 16.1
;I.POS() => S.POS => T.POS => C.POS
    + REC => E.POS => EOR.POS
; SET.I.REC(I.REC())
; SET.I.POS(S.POS)
@BOX 17.1
END
@BOX 42.1
; 127 => F
@BOX 12.1
; 122 => F
@BOX 7.1
; 121 => F
@BOX 5.1
; IF MODE /= 4
@BOX 20.1
; IF STATUS & %80 /= 0
@BOX 14.1
;O.POS() => S.POS => C.POS => T.POS + REC => E.POS
; SET.O.REC(O.REC())
;SET.O.POS(S.POS)
@BOX 21.1
;IF S & %400 = 0
@BOX 22.1
; FIO.MARK.EOF()
; %FF7F &> STATUS
@BOX 24.1
; IF CUR.FMT /= -2
@BOX 26.1
; OUTCH(SPACE.L)
;1 +> C.POS => T.POS
@BOX 19.1
; ENTER.TRAP(6,126)
@END
@TITLE FTN27.3(1,11)
@COL 1S-40T-15R-41T-3T-6R-9R-14F
@COL 12R
@ROW 6-12
@FLOW 1-40N-15-41N-3N-6-9-14
@FLOW 3Y-12-14
@FLOW 40Y-12
@FLOW 41Y-12
@BOX 1.0
SELECT.DA.UNIT
     (UNIT,FMT.TBL.PTR,CHAR.TBL.PTR,MODE,REC.NO)
@BOX 40.0
SEARCH UNIT TABLE
FOR UNIT NUMBER
NOT FOUND ?
@BOX 41.0
LIST DIRECTED FORMATTING
@BOX 3.0
UNIT NOT OPEN FOR
DIRECT ACCESS USE
@BOX 6.0
SELECT INPUT
SELECT OUTPUT
SELECT RECORD POSITION
SET UP RECORD
@BOX 9.0
UPDATE UNIT ACCESS STATUS
SAVE RECORD NO
IN UNIT TABLE
@BOX 14.0
END
@BOX 12.0
FAULT
'WRONG TYPE OF
UNIT ACCESS'
@BOX 15.0
SET RECORD INFO
:27.20:
@BOX 1.1
; PROC FIO.SELECT.DA.UNIT
    (UNIT.ID,FMT.TBL.PTR,CHAR.TBL.PTR,MODE,REC.NO)
; ADDR UNIT CUR
; $LO16 S
; $IN RN
; ADDR [$LO8] FN,FNI
;$IN I
@BOX 40.1
; FIO.SEARCH.UNIT.TABLE(UNIT.ID,0) => CUR
; IF CUR = NIL OR STATUS OF CUR^ => S & %200 = 0
@BOX 15.1
; SET.REC.INFO(FMT.TBL.PTR, CHAR.TBL.PTR, MODE)
; SELECT CUR^
@BOX 41.1
; IF CUR.FMT = -2
@BOX 3.1
; IF S & %20E /= %20E
@BOX 6.1
; SELECT.INPUT(STREAM.NO)
; SELECT.OUTPUT(STREAM.NO)
; SET.OPOS(REC.NO -1 * REC => S.POS => T.POS => C.POS)
; REC + S.POS => E.POS => EOR.POS
@BOX 9.1
; REC.NO => RECORD.NO
@BOX 14.1
END
@BOX 12.1
; ENTER.TRAP(6,122)
@END
@TITLE FTN27.4(1,11)
@COL 1S-40T-8R-3R-4R-5F
@COL 41R
@ROW 8-41
@FLOW 1-40N-8-3-4-5
@FLOW 40Y-41
@BOX 1.0
SELECT STRING(STRING,REC.CNT,REC.LEN,FMT.TBL.PTR,CHAR.TBL.PTR,MODE)
@BOX 40.0
LIST DIRECTED
OR UNFORMATTED ?
@BOX 41.0
FAULT
' INVALID INTERNAL I/O'
@BOX 3.0
SET BOUND ON STRING
DEFINE CHAR STRING STRM
FOR OUTPUT UNIT
@BOX 4.0
SELECT INPUT AND OUTPUT
SET UP RECORD
@BOX 5.0
END
@BOX 6.0
DEFINE CHAR STRING
STRM FOR INPUT UNIT
@BOX 8.0
SAVE FORMAT
SET RECORD LENGTH
SET BLK
@BOX 1.1
; PROC FIO.SELECT.STRING(STRING,REC.CNT,REC.LEN,FMT.TBL.PTR,CHAR.TBL.PTR,MODE)
; $IN32 REC
; $IN S
@BOX 40.1
; %100 !> REST.REQ
; IF MODE & 3 /= 0
@BOX 8.1
; IF FMT.TBL.PTR /= NIL.TBL THEN
     FMT.TBL.PTR => FMT.TBL
     ; CHAR.TBL.PTR => CHAR.CONST.TBL
FI
; REC.LEN - REC.HDR.Z => REC
; NIL => CUR.UNIT
; 0 => BLK => POS.S => CUR.FMT
@BOX 3.1
; PART(STRING,0,REC.CNT*REC.LEN-1) => STRING
; DEFINE.STRING.IO(-1,STRING,0) => S => STREAM.NO OF IN.RES
@BOX 4.1
; SELECT.INPUT(S)
; SELECT.OUTPUT(S)
; I.REC() => REC
; IF MODE & 8 = 0 THEN
   ; SET.I.REC( REC)
; ELSE
   ; SET.O.REC( REC)
; FI
; SET.I.POS(0)
; 0 => S.POS => C.POS => T.POS + REC => E.POS => EOR.POS
@BOX 5.1
END
@BOX 41.1
; ENTER.TRAP(6,125)
@END
@TITLE FTN27.5CV(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
TRAPPING PROCEDURES
@BOX 2.0
TRAP.RESTART :FTN27.5.1:
CONNECT.FILE :FTN27.5.2:
SET.UP.TRAPS :FTN27.5.3:
SET.DOWN.TRAPS:FTN27.5.4:
@BOX 3.0
END
@BOX 1.1
::BEGIN
;P.SPEC FIO.TRAP.RESTART(ADDR[$LO8], ADDR $IN, ADDR $IN)/$IN
;P.SPEC SET.UP.TRAPS()
;P.SPEC SET.DOWN.TRAPS()
@BOX 2.1
#FTN27.5.1CV
#FTN27.5.2CV
#FTN27.5.3CV
#FTN27.5.4CV
@BOX 3.1
::END
@END
@TITLE FTN27.5.1CV(1,11)
@COL 1S-2R-3T-40T-41R-4R-5R-6R-7R-11F
@COL 8R-9R-10C
@ROW 4-8
@FLOW 1-2-3N-40N-41-4-5-6-7-11
@FLOW 3Y-8-9-10
@FLOW 40Y-4
@BOX 1.0
TRAP.RESTART (TRAP.NO,REASON)
@BOX 2.0
SET STATUS TO ACCESSED ::CV
DECODE TRAP NO,REASONS
AS ERROR OR END OF FILE
CONDITIONS
@BOX 3.0
RETURN TO USER PROGRAM
NOT REQUIRED?
@BOX 40.0
ERROR ?
@BOX 41.0
NOTE ENDFILE
ON CURRENT UNIT
@BOX 4.0
SET IO-STATUS
IN PW0
@BOX 5.0
RESET OLD TRAP
@BOX 6.0
UNWIND PROCEDURE
STACK
@BOX 7.0
RE-ENTER
USER PROGRAM
AT RESTART POINT
@BOX 11.0
END
@BOX 8.0
RESET TRAP
PROC TO STANDARD
TRAP
@BOX 9.0
ENTER TRAP
PROC
@BOX 10.0
EXIT
@BOX 1.1
;PROC FIO.TRAP.RESTART (LIBID, NO, REASON)
; $IN S ::CV
ADDR LOGICAL64 TEMPLIB;
LITERAL / LOGICAL64 CVMOSLIB = "CVMOSLIB";
@BOX 2.1
MAKE (LOGICAL64, 0, BYTE(LIBID) ) => TEMPLIB;

::CV &&&JAE 2/9/82 ADDED STATUS SET
::CV moved ; 1 !> STATUS OF CUR.UNIT^
:: DONE IN BOX 3
@BOX 3.1
::CV &&&JAE 2/13/82 MODIFIED IF CLAUSE
;IF REST.REQ&3 = 0 OR
    [REST.REQ&3 = 2 AND
      [NO^ /= 6 OR REASON^ /= 1 OR CVMOSLIB /= TEMPLIB^]]
@BOX 4.1
::CV &&&JAE 2/13/82 MODIFIED IF CLAUSE
;IF NO^ = 6 AND REASON^ = 1
   AND TEMPLIB^ = CVMOSLIB
 THEN -1 => PW0
 ELSE REASON^ => PW0 FI
@BOX 5.1
; 0 => REST.REQ ::CV
@BOX 6.1
:: DONE IN BOX 7
@BOX 7.1
; -> RESTART.LABEL
@BOX 8.1
::CV **** START OF NEW CODE FOR IMPROVED MESSAGES
; IF REST.REQ /= 0 THEN
     SELECT.OUTPUT (0)
   ; CAPTION(%" *** An ERROR occurred during a FORTRAN Input/Output operation **
*$L")
   ; IF CUR.UNIT /= NIL THEN
      ; IF STATUS OF CUR.UNIT^ => S & %200 = 0 THEN
         ; CAPTION (%"     but the Unit is closed and no meaningfull details can
 be given")
   ELSE CAPTION (%"     On ")
      ; IF S & %60 = %20 THEN
           CAPTION (%"Formatted/")
        ELSE IF S & %60 = %40 THEN
           CAPTION (%"Unformatted/")
        FI FI
      ; IF S & %2 = 0 THEN CAPTION (%"Sequential")
        ELSE CAPTION (%"Direct") FI
      ; CAPTION (%" Unit ")
      ; OUT.I (UNIT.NO OF CUR.UNIT^,0)
      ; IF S & 1 = 0 THEN CAPTION (%" (which is marked as unaccessed or rewound)
")
       ELSE
      ; CAPTION (%" Using ")
      ; IF S & %4 /= 0 THEN CAPTION (%"Input") FI
      ; IF S & %C = %C THEN OUTCH ('/) FI
      ; IF S & %8 /= 0 THEN CAPTION (%"Output") FI
      ; CAPTION (%" Stream ")
      ; OUT.I (STREAM.NO OF CUR.UNIT^,0)
        FI
      ; IF BYTES OF CUR.UNIT^ => S /= 0 THEN
         ; CAPTION (%"$L         attached to file ")
         ; CAPTION (PART (^FILE.NAME OF CUR.UNIT^,0,S-1))
        FI
     FI
    ELSE
      ; CAPTION (%" On an Internal file buffer using stream ")
      ; OUT.I (STREAM.NO OF IN.RES,0)
    FI
  ; NEWLINES (1)
FI
; 1 !> STATUS OF CUR.UNIT^
::CV *** end of code for improved messages
@BOX 9.1
;0 => FIO.TRAP.RESTART
@BOX 10.1
EXIT
@BOX 11.1
END
@BOX 40.1
; 1 !> STATUS OF CUR.UNIT^ ::CV
; IF REASON^ > 1 OR CUR.UNIT = NIL
@BOX 41.1
; %80 !> STATUS OF CUR.UNIT^
@END
@TITLE FTN27.5.2CV(1,11)
@COL 12S-13R-14R-15F
@FLOW 12-13-14-15
@BOX 12.0
CONNECT.FILE(FILE.NAME)
@BOX 13.0
LOCAL.TRAP()
CODE^ => PW0
2 => LOCAL.TRAP
END
@BOX 14.0
READ AND SET TRAP TO
LOCAL TRAP
VERIFY IF THE FILE EXISTS
USING THE DEFINE.INPUT CALL
RESET THE TRAP
@BOX 15.0
END
@BOX 12.1
;PROC CONNECT.FILE(FILE.NAME)
@BOX 13.1
;P.SPEC LOCAL.TRAP(ADDR[$LO8],ADDR $IN,ADDR $IN)/$IN
; ADDR LOCAL.TRAP SAVE.TRAP
;PROC LOCAL.TRAP(LIBID,CLASS,CODE)
;CODE^ => PW0
;2 => LOCAL.TRAP
;END
@BOX 14.1
;0 => PW0
;READ.TRAP.PROC() => SAVE.TRAP
;SET.TRAP.PROC(^LOCAL.TRAP)
;DEFINE.INPUT(-1,FILE.NAME,4,0) => CONNECT.FILE
;SET.TRAP.PROC(SAVE.TRAP)
;IF PW0 /= 0 THEN -1 => CONNECT.FILE
;0 => PW0
 FI
@BOX 15.1
;END
@END
^L@TITLE FTN27.5.3CV(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
SET.UP.TRAPS
@BOX 2.0
DO INITIALISATIONS
@BOX 3.0
END
@BOX 1.1
;PROC SET.UP.TRAPS
@BOX 2.1
    ;SET.TRAP.PROC (^FIO.TRAP.RESTART)
@BOX 3.1
;END
@END
@TITLE FTN27.5.4CV(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
SET.DOWN.TRAPS
@BOX 2.0
DO NOTHING AT ALL
@BOX 3.0
END
@BOX 1.1
;PROC SET.DOWN.TRAPS
@BOX 2.1
::NOTHING AT ALL
@BOX 3.1
;END
@END
@TITLE FTN27.5(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
TRAPPING PROCEDURES
@BOX 2.0
TRAP.RESTART :FTN27.5.1:
CONNECT.FILE :FTN27.5.2:
SET.UP.TRAPS :FTN27.5.3:
SET.DOWN.TRAPS:FTN27.5.4:
@BOX 3.0
END
@BOX 1.1
::BEGIN
; *GLOBAL 5
;ADDR ENTER.TRAP [NO.OF.TRAPS] OLD.TRAP
;$IN [NO.OF.TRAPS] OLD.STATUS
; *GLOBAL 0
;P.SPEC SET.UP.TRAPS()
;P.SPEC SET.DOWN.TRAPS()
;P.SPEC FIO.TRAP.RESTART ($IN,$IN)
@BOX 2.1
#FTN27.5.1
#FTN27.5.2
#FTN27.5.3
#FTN27.5.4
@BOX 3.1
::END
@END
@TITLE FTN27.5.1(1,11)
@COL 1S-2R-3R-4T-41T-42R-5R-6R-7R-8R-12F
@COL 9R-10R-11C
@ROW 5-9
@FLOW 1-2-3-4N-41N-42-5-6-7-8-12
@FLOW 4Y-9-10-11
@FLOW 41Y-5
@BOX 1.0
DECLARATIONS
@BOX 2.0
TRAP.RESTART (TRAP.NO,REASON)
@BOX 3.0
SET STATUS TO ACCESSED ::CV
DECODE TRAP NO,REASONS
AS ERROR OR END OF FILE
CONDITIONS
@BOX 4.0
RETURN TO USER PROGRAM
NOT REQUIRED?
@BOX 41.0
ERROR ?
@BOX 42.0
NOTE ENDFILE
ON CURRENT UNIT
@BOX 5.0
SET IO-STATUS
IN PW0
@BOX 6.0
RESET OLD TRAP
@BOX 7.0
UNWIND PROCEDURE
STACK
@BOX 8.0
RE-ENTER
USER PROGRAM
AT RESTART POINT
@BOX 12.0
END
@BOX 9.0
RESET TRAP
PROC TO STANDARD
TRAP
@BOX 10.0
ENTER TRAP
PROC
@BOX 11.0
EXIT
@BOX 1.1
;PROC FIO.TRAP.RESTART (NO, REASON)
; $LO8[80] FN
@BOX 2.1
;ADDR ENTER.TRAP TRAP
; $IN S
; ADDR [$LO8] P
@BOX 3.1
:: DONE IN BOX 4
@BOX 4.1
;IF REST.REQ&3 = 0 OR
    [REST.REQ&3 = 2 AND
      [NO /= 6 OR REASON /= 1]]
@BOX 5.1
;IF NO = 6 AND REASON = 1 THEN -1 => PW0
 ELSE REASON => PW0 FI
@BOX 6.1
; 0 => REST.REQ
@BOX 7.1
:: DONE IN BOX 7
@BOX 8.1
; -> RESTART.LABEL
@BOX 9.1
; IF REST.REQ /= 0 THEN
     SELECT.OUTPUT (0)
   ; CAPTION(%" *** An ERROR occurred during a FORTRAN Input/Output operation **
*$L")
   ; IF CUR.UNIT /= NIL THEN
      ; IF STATUS OF CUR.UNIT^ => S & %200 = 0 THEN
         ; CAPTION (%"     but the Unit is closed and no meaningfull details can
 be given")
   ELSE CAPTION (%"     On ")
      ; IF S & %60 = %20 THEN
           CAPTION (%"Formatted/")
        ELSE IF S & %60 = %40 THEN
           CAPTION (%"Unformatted/")
        FI FI
      ; IF S & %2 = 0 THEN CAPTION (%"Sequential")
        ELSE CAPTION (%"Direct") FI
      ; CAPTION (%" Unit ")
      ; OUT.I (UNIT.NO OF CUR.UNIT^,0)
      ; IF S & 1 = 0 THEN CAPTION (%" (which is marked as unaccessed or rewound)
")
       ELSE
      ; CAPTION (%" Using ")
      ; IF S & %4 /= 0 THEN CAPTION (%"Input") FI
      ; IF S & %C = %C THEN OUTCH ('/) FI
      ; IF S & %8 /= 0 THEN CAPTION (%"Output") FI
      ; CAPTION (%" Stream ")
      ; OUT.I (STREAM.NO OF CUR.UNIT^,0)
        FI
      ; IF FIO.FILE.NAME(CUR.UNIT,^FN) => P /= VOID THEN
         ; CAPTION (%"$L         attached to file ")
         ; CAPTION (P)
        FI
     FI
    ELSE
      ; CAPTION (%" On an Internal file using stream ")
      ; OUT.I (STREAM.NO OF IN.RES,0)
    FI
  ; NEWLINES (1)
FI
; 1 !> STATUS OF CUR.UNIT^
@BOX 10.1
;OLD.TRAP [NO] => TRAP
;TRAP^ (NO,REASON)
@BOX 11.1
EXIT
@BOX 12.1
END
@BOX 41.1
; 1 !> STATUS OF CUR.UNIT^
; IF REASON > 1 OR CUR.UNIT = NIL
@BOX 42.1
; %80 !> STATUS OF CUR.UNIT^
@END
@TITLE FTN27.5.2(1,11)
@COL 13S-14R-15F
@FLOW 13-14-15
@BOX 13.0
CONNECT.FILE(FILE.NAME)
@BOX 14.0
READ AND SET THE RECOVERY
STATUS. FIND IF THE FILE
EXISTS USING THE DEFINE.
INPUT.
RESET THE RECOVERY STATUS
@BOX 15.0
END (CONNECT.FILE)
@BOX 13.1
;PROC CONNECT.FILE(FILE.NAME)
;$IN ORS
@BOX 14.1
;READ.RECOVERY.STATUS(5) => ORS
;SET.RECOVERY.STATUS(5,1)
;DEFINE.INPUT(-1,FILE.NAME,4) => CONNECT.FILE
;IF PW0 /= 0 THEN -1 => CONNECT.FILE
;0 => PW0
 FI
;SET.RECOVERY.STATUS(5,ORS)
@BOX 15.1
;END
@END
^L@TITLE FTN27.5.3(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
SET.UP.TRAPS
@BOX 2.0
STORE OLD TRAPS AND
SET THEM TO THE TRAPS
@BOX 3.0
END
@BOX 1.1
;PROC SET.UP.TRAPS
;$IN I
@BOX 2.1
;FOR I < NO.OF.TRAPS DO
     READ.RECOVERY.STATUS (I) => OLD.STATUS [I]
    ;READ.TRAP (I) => OLD.TRAP [I]
    ;SET.RECOVERY.STATUS (I,0)
    ;SET.TRAP (I,^FIO.TRAP.RESTART)
 OD
@BOX 3.1
;END
@END
@TITLE FTN27.5.4(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
SET.DOWN.TRAPS
@BOX 2.0
RESET THE ORIGINAL TRAPS
@BOX 3.0
END
@BOX 1.1
;PROC SET.DOWN.TRAPS
;$IN I
@BOX 2.1
;FOR I < NO.OF.TRAPS DO
     SET.TRAP (I,OLD.TRAP [I])
    ;SET.RECOVERY.STATUS (I,OLD.STATUS [I])
 OD
@BOX 3.1
;END
@END
@TITLE FTN27.6(1,6)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
PROC SET.UNIT.REC.L(UNIT,LENGTH)
@BOX 2.0
CHANGE REC LENGTH
@BOX 3.0
END
@BOX 1.1
; PROC FIO.SET.UNIT.REC.L(UNIT,LENGTH)
@BOX 2.1
; FIO.SEARCH.UNIT.TABLE(UNIT,%C)
; LENGTH => RECORD.L OF CUR.UNIT^
@BOX 3.1
END
@END

@TITLE FTN27.7(1,11)
@COL 1S-2R-3T-4N-5F
@COL 6R
@ROW 4-6
@FLOW 1-2-3N-4-5
@FLOW 3Y-6-5
@BOX 1.0
ANALYSE CHAR ARRAY FORMAT
@BOX 2.0
USE RUNTIME FORMAT TABLES
@BOX 3.0
ANALYSE FORMAT
SPECIFICATION :2.1:
FAULTY?
@BOX 5.0
END
@BOX 6.0
FAULTY
ARRAY
FORMAT
@BOX 1.1
; PROC FIO.R.FORMAT(A)
@BOX 2.1
; ^R.FMT.TBL => FMT.TBL
; ^R.CHAR.TBL => CHAR.CONST.TBL
@BOX 3.1
; IF FIO.FORMAT(A,FMT.TBL,CHAR.CONST.TBL,0,0) < 0
@BOX 5.1
END
@BOX 6.1
; ENTER.TRAP(6,118)
@END
@TITLE FTN27.8(1,11)
@COL 1S-2T-3R
@COL 4R-5F
@ROW 3-4
@FLOW 1-2N-3-5
@FLOW 2Y-4-5
@BOX 1.0
SELECT.FORMAT(^FMT.DICT,FMT.LABEL.ID)
@BOX 2.0
IS REQUIRED FORMAT
IN FMT DICTIONARY?
@BOX 3.0
FAULT 119
'FORMAT NOT FOUND'
@BOX 4.0
MAKE IT THE
CURRENT RUN
TIME FORMAT
@BOX 5.0
END
@BOX 1.1
; PROC FIO.SELECT.FORMAT(FMT.DICT,FMT.LABEL)
; $IN LEN,PTR
@BOX 2.1
; SIZE(FMT.DICT) => LEN
; 0 => PTR
; WHILE PTR < LEN AND
         FMT.ID OF FMT.DICT^[PTR] /= FMT.LABEL
     DO 1+> PTR OD
; IF PTR < LEN
@BOX 3.1
; ENTER.TRAP(6,119)
@BOX 4.1
; FMT.TBL.PTR OF FMT.DICT^[PTR] => FMT.TBL
; FMT.CHAR.PTR OF FMT.DICT^[PTR] => CHAR.CONST.TBL
@BOX 5.1
END
@END
@TITLE FTN27.10(1,6)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
FIO.STATUS
@BOX 2.0
RETURN IO STATUS WORD
@BOX 3.0
END
@BOX 1.1
; PROC FIO.STATUS
@BOX 2.1
; PW0 => FIO.STATUS
@BOX 3.1
END
@END
@TITLE FTN27.11(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
OUT.UNIT.TABLE
@BOX 2.0
WRITE OUT TABLE
@BOX 3.0
END
@BOX 1.1
;PROC FIO.OUT.UNIT.TABLE
; ADDR UNIT CUR
; $LO8[80] FN
;$IN I,J
@BOX 2.1
;FOR I < UNIT.TABLE.SZ.L DO
   ; ^UNIT.TABLE[I] => CUR
  ;SELECT CUR^
  ;IF STATUS /= 0 THEN
    ;IF ^UNIT.TABLE[I] = CUR.UNIT THEN
       OUTCH('*) ELSE OUTCH(SPACE.L) FI
    ;OUTI(UNIT.NO,3);OUTCH(SPACE.L)
    ;OUTI(STREAM.NO,3);OUTCH(SPACE.L)
    ;OUTHEX(STATUS,8);OUTCH(SPACE.L)
    ;OUTI(RECORD.L,6);OUTCH(SPACE.L)
    ;OUTI(RECORD.NO,6);OUTCH(SPACE.L)
   ; CAPTION(FIO.FILE.NAME(CUR,^FN))
    ;NEWLINES(1)
  ;FI
OD
@BOX 3.1
END
@END
@TITLE FTN27.12(1,11)
@COL 2S-3R-4R-7R-6R-5F
@FLOW 2-3-4-7-6-5
@BOX 2.0
INIT F RUN
@BOX 3.0
CREATE DATA SEGMENT
@BOX 4.0
INIT UNIT TABLE
@BOX 7.0
SAVE CURRENT STREAMS
@BOX 6.0
SAVE RUN TRAPS
SAVE STOP LABEL
@BOX 5.0
END
@BOX 2.1
; PROC FIO.INIT.RUN(STOP)
; $LO8[3] EXP.N
; $IN I
@BOX 3.1
; 'E => EXP.N[0]
; 'X => EXP.N[1]
; 'P => EXP.N[2]
; IF FINDN(^EXP.N, 0) = 0 THEN
 ; CAPTION(%" **WARNING** Math Functions Library is not loaded$L")
  ;-> STOP FI
; RELEASE.SEGMENT(DATA.SEG)
; CREATE.SEGMENT(DATA.SEG,DATA.SEG.Z)
@BOX 4.1
; FOR I < STR0.OUT.L DO 0 =>STATUS OF UNIT.TABLE[I] OD
; %2A34 => STATUS OF UNIT.TABLE[STR0.IN.L]
; %2A38 => STATUS OF UNIT.TABLE[STR0.OUT.L]
; 80 => RECORD.L OF UNIT.TABLE[STR0.IN.L]
; 120 => RECORD.L OF UNIT.TABLE[STR0.OUT.L]
; -1 => UNIT.NO OF UNIT.TABLE[STR0.OUT.L] => UNIT.NO OF UNIT.TABLE[STR0.IN.L]
; 0 => STREAM.NO OF UNIT.TABLE[STR0.OUT.L] => STREAM.NO OF UNIT.TABLE[STR0.IN.L]
@BOX 7.1
; CURRENT.INPUT() => OIS
; CURRENT.OUTPUT() => OOS
@BOX 6.1
;NIL => CUR.UNIT
;SET.UP.TRAPS()
; 0 => REST.REQ
; STOP => END.PROG
@BOX 5.1
END
@END
@TITLE FTN27.13(1,11)
@COL 1S-2R-3T-4T-6R-7R-9R-10R-11R-8F
@FLOW 1-2-3N-4N-6-7-9-10-11-8
@FLOW 3Y-7
@FLOW 4Y-7
@BOX 1.0
END.F.RUN
@BOX 2.0
FOR EACH UNIT IN
UNIT TABLE
@BOX 3.0
UNIT CLOSED
AND UNIT NOT
PRECONNECTED AND
ACCESSED
@BOX 4.0
UNIT CONNECTED TO
STREAM 0?
@BOX 6.0
CLOSE UNIT
@BOX 7.0
REPEAT
@BOX 9.0
RESET OLD STREAMS
@BOX 10.0
RESET OLD TRAPS
@BOX 8.0
END
@BOX 11.0
RELEASE DATA SEGMENT
@BOX 1.1
; PROC FIO.END.RUN
; $IN I
@BOX 2.1
; FOR I < UNIT.TABLE.SZ.L DO
@BOX 3.1
; SELECT UNIT.TABLE [I]
; IF STATUS & %211 /= %201
@BOX 4.1
;IF STREAM.NO = 0
@BOX 6.1
; FIO.CLOSE(UNIT.NO,VOID)
@BOX 7.1
OD
@BOX 9.1
; SELECT.INPUT(OIS)
; SELECT.OUTPUT(OOS)
@BOX 10.1
;SET.DOWN.TRAPS()
@BOX 8.1
END
@BOX 11.1
; RELEASE.SEGMENT(DATA.SEG)	
@END
@TITLE FTN27.20(1,11)
@COL 1S-2T-3T-4T-5R-6R-7F
@COL 8T-9R
@ROW 8-5
@FLOW 1-2-3N-4-5-6-7
@FLOW 3Y-6
@FLOW 4Y-8N-9-7
@FLOW 8Y-6
@BOX 1.0
PROC SET REC INFO
@BOX 2.0
NOTE REC TYPE
   FMT/LD FMT/UNF/UNKNOWN
SET FORMAT GLOBALS
@BOX 3.0
REC TYPE FOR THIS IO OPERATION
NOT KNOWN
@BOX 4.0
REC TYPE SET FOR UNIT
@BOX 5.0
SET REC TYPE, REC LEN
IN UNIT TABLE
@BOX 6.0
SET OPTIONS
@BOX 7.0
END
@BOX 8.0
CONSISTENT USE OF REC TYPE
ON UNIT
@BOX 9.0
FAULT
@BOX 1.1
;PROC SET.REC.INFO(F.TBL, C.TBL, M)
;$IN FM
@BOX 2.1
; M & 3 => M -: 0 => CUR.FMT
; %A0 ->> M & %60 => FM
; IF F.TBL = NIL.TBL THEN
   ; IF M = 2 THEN
      ; ^LD.FMT.TBL => FMT.TBL
   ; FI
;ELSE
   ; F.TBL => FMT.TBL
   ; C.TBL => CHAR.CONST.TBL
   ; 0 => CUR.FMT
; FI
@BOX 3.1
; IF FM = 0
@BOX 4.1
; SELECT CUR.UNIT^
; IF STATUS & %60 /= 0
@BOX 5.1
; FM !> STATUS
; IF FM & %20/= 0 THEN
   ; 135 => RECORD.L
; ELSE
   ; %7FF0 => RECORD.L
; FI
@BOX 6.1
; RECORD.L => REC
; 0 => POS.S
; STATUS ->> 8 & 1 => BLK
@BOX 7.1
; END
@BOX 8.1
;IF STATUS & FM /= 0
@BOX 9.1
; ENTER.TRAP (6, 122)
@END


