@X @~
~L3 COUK1247
80
~V7 56 2 -5
~D10
~H                    MUSS
~
~
~D10
~H            FTN251
~D10
~MMANCHESTER UNIVERSITY  -  CONFIDENTIAL~
~
~
                                                            ISSUE 10~
~V9 -1
~P
~V9 1
~YFTN251
~S1~M~OFORTRAN 77 I/O LIBRARY IMPLEMENATION DESCRIPTION
~S1~M~OSection 25~
~S1~OSection 25. Auxiliary I/O Procedures
~S1~O1.1 General Description
~BThis section of the Library contains the auxiliary input/output
procedures which implement the Fortran BACKSPACE, ENDFILE, REWIND, OPEN,
CLOSE, and INQUIRE statements. These routines use the unit table
to discover details of the unit on which the operation is to be performed,
and to communicate between each other. The Unit table contains details
of the Status of a unit to which stream is connected.
~S1~O1.2 Non Standard Features
~BThe methods by which a preconnected unit is associated with a file is
left undefined in the Fortran 77 standard, and implementors are free to
do what is best on their own system. In this Fortran 77 implementation
the Fortran Unit numbers are associated with MUSS stream numbers by
using modulo 8. For example the Fortran Unit 12 is associated with
the MUSS stream 4, and this stream should have been defined outside
the program by the appropriate MUSS commands.
~BOnce the MUSS stream number has been calculated it must be determined
if the stream is an input or output one. Normally it is the first
access to a unit which determines if it is input or output but with most
of the auxiliary I/O it is not clear whether a preconnected unit is input
or output. To resolve this problem in auxiliary I/O a search is made
of the already connected unit numbers to locate any other connections
for the same stream number. If a REWIND is made on unit 4 (hence stream 4)
and stream 4 was already connected for output for unit 12 then unit 4
must be an input unit! If both input and output streams are already
connected then the new unit number must be invalid. If the stream
number has not previously been used then the two streams of the desired
number are examined. If only one of the two streams is defined then
that must be the one connected to the unit. If both are connected it is an
ambiguous case and cannot be resolved.
~BThe MUSS system causes further complications for the BACKSPACE. MUSS
streams may be divided into several sections, and when each section is
finished with processing continues with the next section. Any I/O operations
may only apply to the section currently being processed, and a BACKSPACE
from one section to the previous one is not possible. This restriction
does not apply to REWIND which operates differently. A REWIND causes
the stream to be broken and re-connected when it is needed again, this
means that any output destined for a process will be sent when a rewind
occurs and any further output will also be sent as more sections.
~BWhen a INQUIRE is made to a pre-connected file by name, the enquiry
will not be able to determine which unit the file is connected too unless
the unit has been accessed previously. This is because it is difficult
to locate a stream by file name, as an inquiry by file name will only
pick up details about the file, not the connection.
~S1~O2. Interfaces
~S1~O2.1 Section Interfaces Used
~
   Section 21:   (Configuration Section)~
   Section 27:   (Unit Control Procedures)~
~S1~O2.2 Section Interface
~
Library Procedures:~
   FIO.B.SPACE~
   FIO.ENDFILE~
   FIO.REWIND~
   FIO.OPEN~
   FIO.CLOSE~
   FIO.INQUIRE~
   FIO.INQUIRE.EXIST~
   FIO.INQUIRE.OPENED~
   FIO.INQUIRE.NUMBER~
   FIO.INQUIRE.NAMED~
   FIO.INQUIRE.NAME~
   FIO.INQUIRE.ACCESS~
   FIO.INQUIRE.SEQUENTIAL~
   FIO.INQUIRE.DIRECT~
   FIO.INQUIRE.FORM~
   FIO.INQUIRE.FORMATTED~
   FIO.INQUIRE.UNFORMATTED~
   FIO.INQUIRE.RECL~
   FIO.INQUIRE.NEXTREC~
   FIO.INQUIRE.BLANK~
~
Exported Procedures:~
   FIO.MARK.EOF~
   FIO.SEARCH.UNIT.TABLE~
   FIO.CH.COMP~
~S1~O3. Implementation
~S1~O3.1 Outline of Operation
~S1~O3.1.1 FIO.B.SPACE(UNIT)
~BThis procedure positions the unit at the start of the
current input/output record.
~BThe unit table is searched for the unit number specified, and an error
generated if the unit had not previously been accessed. The desired unit
is then selected for sequential access. If the unit is connected for input
a check is made to see if an endfile record has just been read as this
is backspaced differently to other records. If the unit is connected
for output, a similar check for having just written an endfile record.
If an output the file is positioned at the end, and is backspaced
to the penultimate record a check is made to ensure the last record of the
file is always an endfile record.
~S1~O3.1.2 FIO.ENDFILE(UNIT)
~BThis procedure outputs an endfile record to the
specified unit.
~BThe unit specified is selected for writing in sequential access and
then an endfile record is written using MARK.EOF.
~S1~O3.1.3 FIO.REWIND(UNIT)
~BThis procedure rewinds the specified unit.
~BA check is made to ensure that the unit specified is connected, and sequential
access has been specified. The unit is then closed, but marked as open and
unaccessed, so that the next access causes the unit to be re-connected
at the start of the same file.
~S1~O3.1.4 FIO.OPEN(UNIT,FILE,STATUS,ACCESS,FORM,RECL,BLANK)
~BThis procedure is used to initiate the connection of a
file to a unit, or change certain specifiers of a connection
between a file and a unit.
~BThe OPENing of a unit already connected to a file is permitted.
The possible actions are:~
~T# 4
~
1.
~IThe FILE parameter is the same as the file to which the unit
is preconnected and the unit has not yet been accessed, then
the parameters specified become a part of the connection.~
~
2.
~IThe FILE parameter is the same as the file to which the unit
is connected, then the BLANK specifier of the connection may
be altered.~
~
3.
~IThe FILE parameter is nil. If the unit is pre-connected and
unaccessed the action is as (1) and if it is connected the
action is as (2).~
~
4.
~IThe FILE parameter is different to that (pre)connected to the
unit. The unit is closed (with default STATUS) before the new
file unit connection is established.~
~BFor STATUS, ACCESS, FORM and BLANK all trailing blanks are
not considered as part of the character string for these parameters.
~S1Input Parameters:-~
~3
~
   P1  UNIT   Unit number.~
   P2  FILE   Nil or filename.~
   P3  STATUS 'OLD','NEW','SCRATCH' or 'UNKNOWN'.~
              Nil default gives UNKNOWN.~
   P4  ACCESS 'SEQUENTIAL' or 'DIRECT'.~
              Nil default gives SEQUENTIAL.~
   P5  FORM   'FORMATTED' or 'UNFORMATTED'.~
              Nil default gives FORMATTED for SEQUENTIAL~
              and UNFORMATTED for DIRECT.~
   P6  RECL   Record length in bytes which should be greater~
              than zero. Only required for direct access.~
   P7  BLANK  'NULL' or 'ZERO'.~
              Nil default gives 'NULL'.~
~0
~BThe character string parameters are validated by comparing them with
the permitted options using CH.COMP. The unit table is then searched
to locate the unit number or a vacant entry. If the unit is already
opened a check is made to see if the unit is to be closed and re-opened,
or whether the BLANK specifier is to be updated. If the unit is to be
opened the combinations of the various parameters and the status of the
specified file achieved, and then the details are stored in the
unit table. No connection between unit and file is made at this stage,
but is made on the first access.
~S1~O3.1.5 FIO.CLOSE(UNIT,STATUS)
~BThis procedure terminates the connection of a file to a unit.
~S1Input Parameters:-~
~3
~
   P1  UNIT    Unit number.~
   P2  STATUS  Specifies the disposition of the file.~
               'KEEP' or 'DELETE'. Nil default is KEEP~
               unless the file connection specifies SCRATCH~
               in which case the default is 'DELETE'.~
~0
~BThe unit table is searched for the unit specified, and a check made
on the status parameter. If the connection for sequential access
output a check is made to ensure an endfile record is written,
the stream is then released or broken as appropriate, and the unit
table update to indicate closure.
~S1~O3.1.6 FIO.INQUIRE(UNIT,FILE)
~BThis procedure allows information to be obtained of
a file unit connection.
~S1Input Parameters:-~
~3
~
   UNIT  >=0 Unit no. INQUIRE by unit.~
         -1  Enquire by filename.~
   FILE  Name of file if enquire by filename,~
         otherwise nil.~
~0
~BA search of the unit table is made to locate the unit or file specified,
and details from the unit table entry found are saved. If no entry
in the unit table is found for an inquire by unit then the unit is assumed close
d.
If no entry in the unit table is found for an inquire by file name
then the operating system must be interrogated about the file, and the
details saved. If the file was pre-connected to a unit which has not been
accessed no details about the connection will be present in the unit
table, so the result of an inquire by file name would be the same
as if there was no connection, as described earlier.
~BThe details produced by the inquiry can be individually decoded
into the forms required for Fortran by the 14 other inquiry procedures.
Therefore, for a complete inquiry from a Fortran program, first FIO.INQUIRE
must be called to locate the require details and an appropriate
selection of the decoding procedures for the desired results. Calling a
decoding procedure without first having called FIO.INQUIRE will give
an undefined result.
~BThe other 14 inquiry procedures are:~
~
FIO.INQUIRE.EXIST()LOGICAL.RESULT~
FIO.INQUIRE.OPENED()LOGICAL.RESULT~
FIO.INQUIRE.NUMBER()INTEGER.RESULT~
FIO.INQUIRE.NAMED()LOGICAL.RESULT~
FIO.INQUIRE.NAME()/STRING.DESCRIPTOR~
FIO.INQUIRE.ACCESS()/STRING.DESCRIPTOR~
FIO.INQUIRE.SEQUENTIAL()/STRING.DESCRIPTOR~
FIO.INQUIRE.DIRECT()/STRING.DESCRIPTOR~
FIO.INQUIRE.FORM()/STRING.DESCRIPTOR~
FIO.INQUIRE.FORMATTED()/STRING.DESCRIPTOR~
FIO.INQUIRE.UNFORMATTED()/STRING.DESCRIPTOR~
FIO.INQUIRE.RECL()INTEGER.RESULT~
FIO.INQUIRE.NEXTREC()INTEGER.RESULT~
FIO.INQUIRE.BLANK()/STRING.DESCRIPTOR~
~S1~O3.1.7 FIO.MARK.EOF()
~BThis outputs an appropriate endfile record and notes in the unit table that
the file is positioned at its end.
~S1~O3.1.8 FIO.SEARCH.UNIT.TABLE(UNIT,I/O)
~BThis procedure is called whenever the above routines need to search
the unit table for a particular unit number. It first checks that the unit
number specified is positive and then searches the unit table. If
the unit is not found in the table it investigates if it has been
pre-connected, or if there is a vacant entry in the table for a new unit.
A result is placed in the current unit pointer.
~BWhen a pre-connected unit is found, the unit table is updated with details
of the connection obtained from the operating system.
When Bit 4 of parameter 2 is set, it indicates that either
of the default units are to be selected.
~S1~O~S13.1.9 FIO.CH.COMP(FIRST,SECOND)
~BThis routine is used to compare two byte vectors for equality. The byte
vectors may be of different lengths because they contain varying numbers
of trailing blanks which are not significant in the comparision.
~S1~O3.2 Data Structures
~BThis section uses the unit table which is described in section 27, extensively
.
~Y
~V9 -1
~P
~D15
~HFLOWCHARTS
~
~
~H                FTN251
~V9 -1
~F
@TITLE FTN25(1,11)
@COL 1S-2R-4R-7R-9F
@FLOW 1-2-4-7-9
@BOX 1.0
AUXILIARY I/O SECTION

@BOX 2.0
[IMPORTS FTN25/1]
MODULE HEADING
@BOX 4.0
LITERAL DECLARATIONS
@BOX 7.0
PROCEDURES IN MODULE
   FTN25.1:BACKSPACE
   FTN25.2:ENDFILE
   FTN25.3:REWIND
   FTN25.4:OPEN
   FTN25.5:CLOSE
   FTN25.6:INQUIRE
   FTN25.7:MARK EOF
   FTN25.8:SEARCH.UNIT.TABLE
   FTN25.9:CH.COMP
FTN25.10
@BOX 9.0
END
@BOX 2.1
#FTN25/1
;MODULE(FIO.B.SPACE,FIO.ENDFILE,FIO.REWIND,FIO.OPEN,FIO.CLOSE,FIO.INQUIRE,
   FIO.INQUIRE.EXIST,FIO.INQUIRE.OPENED,FIO.INQUIRE.NUMBER,FIO.INQUIRE.NAMED,
   FIO.INQUIRE.NAME,FIO.INQUIRE.ACCESS,FIO.INQUIRE.SEQUENTIAL,FIO.INQUIRE.DIRECT
,
   FIO.INQUIRE.FORM,FIO.INQUIRE.FORMATTED,FIO.INQUIRE.UNFORMATTED,FIO.INQUIRE.RE
CL,
   FIO.INQUIRE.NEXTREC,FIO.INQUIRE.BLANK,FIO.MARK.EOF,FIO.SEARCH.UNIT.TABLE,
   FIO.CH.COMP,FIO.FILE.NAME,FIO.STRIP.BLANKS);
@BOX 4.1
;LITERAL/ADDR [$LO8] VOID =
;LITERAL/ADDR UNIT NIL =
;LITERAL/ADDR [$IN16] NIL.TBL =
; *GLOBAL 5
; ADDR[$LO8] IN.FILE.NAME.P
; $LO8[80] IN.FILE.NAME
; *GLOBAL 4
;DATAVEC UNKNOWN($LO8)
"UNKNOWN"
END
;DATAVEC SEQUENTIAL($LO8)
"SEQUENTIAL"
END
;DATAVEC DIRECT($LO8)
"DIRECT"
END
;DATAVEC FORMATTED($LO8)
"FORMATTED"
END
;DATAVEC UNFORMATTED($LO8)
"UNFORMATTED"
END
;DATAVEC NULL($LO8)
"NULL"
END
;DATAVEC ZERO($LO8)
"ZERO"
END
;DATAVEC YES($LO8)
"YES"
END
;DATAVEC NO($LO8)
"NO"
END
;DATAVEC STAR($LO8)
"*"
END
; *GLOBAL 0
@BOX 7.1
;L.SPEC FIO.B.SPACE($IN32)
;L.SPEC FIO.ENDFILE($IN32)
;L.SPEC FIO.REWIND($IN32)
;L.SPEC FIO.OPEN($IN32,ADDR[$LO8],ADDR[$LO8],ADDR[$LO8],ADDR[$LO8],$IN32,ADDR[$L
O8],$IN16)
;L.SPEC FIO.CLOSE($IN32,ADDR[$LO8])
;L.SPEC FIO.INQUIRE($IN32,ADDR[$LO8])
;L.SPEC FIO.INQUIRE.EXIST()/$LO16
;L.SPEC FIO.INQUIRE.OPENED()/$LO16
;L.SPEC FIO.INQUIRE.NUMBER()/$IN32
;L.SPEC FIO.INQUIRE.NAMED()/$LO16
;L.SPEC FIO.INQUIRE.NAME()/ADDR[$LO8]
;L.SPEC FIO.INQUIRE.ACCESS()/ADDR[$LO8]
;L.SPEC FIO.INQUIRE.SEQUENTIAL()/ADDR[$LO8]
;L.SPEC FIO.INQUIRE.DIRECT()/ADDR[$LO8]
;L.SPEC FIO.INQUIRE.FORM()/ADDR[$LO8]
;L.SPEC FIO.INQUIRE.FORMATTED()/ADDR[$LO8]
;L.SPEC FIO.INQUIRE.UNFORMATTED()/ADDR[$LO8]
;L.SPEC FIO.INQUIRE.RECL()/$IN32
;L.SPEC FIO.INQUIRE.NEXTREC()/$IN32
;L.SPEC FIO.INQUIRE.BLANK()/ADDR[$LO8]
; P.SPEC FIO.MARK.EOF()
; P.SPEC FIO.SEARCH.UNIT.TABLE($IN32,$LO8)/ADDR UNIT
; P.SPEC FIO.CH.COMP(ADDR[$LO8],ADDR[$LO8])/$IN
; P.SPEC FIO.FILE.NAME(ADDR UNIT,ADDR[$LO8])/ADDR[$LO8]
; P.SPEC FIO.STRIP.BLANKS(ADDR[$LO8])/ADDR[$LO8]
#FTN25.1
#FTN25.2
#FTN25.3
#FTN25.4
#FTN25.5
#FTN25.6
#FTN25.7
#FTN25.8
#FTN25.9
#FTN25.10
#FTN25.11
@BOX 9.1
;*END
@END
@TITLE FTN25/1(1,11)
@COL 1S-2R-3R-4R-5R-6R-7F
@FLOW 1-2-3-4-5-6-7
@BOX 1.0
AUXILIARY 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
;TYPE UNIT IS
      $LO16 STATUS
      $IN32 RECORD.L,RECORD.NO,MAX.RECORD.POS,MAX.POS,UNIT.NO
      $IN16 STREAM.NO
@BOX 3.1
;IMPORT LITERAL $LO8 SPACE.L,EOT
;IMPORT LITERAL UNIT.TABLE.SZ.L,STR0.IN.L,STR0.OUT.L
;IMPORT LITERAL $IN32 MAX.SECTION.Z.L
@BOX 4.1
;ADDR UNIT CUR.UNIT
;UNIT IN.RES
;$IN OOS,OIS
;ADDR PW0, PW1, PW4
;$IN REST.REQ
;$LO64 PWW1,PWW2
@BOX 5.1
;UNIT [UNIT.TABLE.SZ.L] UNIT.TABLE
@BOX 6.1
;P.SPEC CONNECT.FILE(ADDR [$LO8])/$IN
;P.SPEC FIO.SELECT.SEQ.UNIT($IN32,ADDR[$IN16],ADDR[$LO8],$IN16)
;L.SPEC IN.BACK.SPACE($IN)
;L.SPEC OUT.BACK.SPACE($IN)
;L.SPEC ENTER.TRAP($IN,$IN)
;L.SPEC DEFINE.INPUT($IN,ADDR[$LO8],$IN32)/$IN
;L.SPEC DEFINE.IO($IN,ADDR[$LO8],$IN32,$IN32)/$IN
;L.SPEC END.INPUT($IN,$IN)
;L.SPEC END.OUTPUT($IN,$IN)
;L.SPEC DELETE(ADDR[$LO8])
;L.SPEC SELECT.INPUT($IN)
;L.SPEC NEWLINES($IN)
;L.SPEC OUT.CH($IN)
;L.SPEC R.SIZE()/$IN32
;L.SPEC SET.I.REC($IN32)
;L.SPEC SET.O.REC($IN32)
;L.SPEC O.REC()/$IN32
;L.SPEC SELECT.DOC()
;L.SPEC BACK.REC()
;L.SPEC SET.O.POS($IN32)
;L.SPEC SET.I.POS($IN32)
;L.SPEC I.DOC()/ADDR[$LO8]
;L.SPEC O.DOC()/ADDR[$LO8]
;L.SPEC O.POS()/$IN32
;L.SPEC END.POS()
::NOT YET MU ;L.SPEC IN.BACK.REC($IN)
::CV ;L.SPEC IN.BACK.REC()
::NOT YET MU ;L.SPEC OUT.BACK.REC($IN)
::CV ;L.SPEC OUT.BACK.REC()
::CV;L.SPEC I.MODE(ADDR[$LO8])/$IN32
::MU ;L.SPEC I.MODE()/$IN32
;L.SPEC SELECT.OUTPUT($IN)
::CV ;L.SPEC O.MODE(ADDR[$LO8])/$IN32
::MU ;L.SPEC O.MODE() /$IN32
::CV;L.SPEC SET.DOCUMENT.END($IN32)
;L.SPEC OUT.REC()
@END
@TITLE FTN25.1(1,11)
@COL 1S-3R-4T-5R-6R-7T-12R-13F
@COL 14R-15C-17R
@ROW 5-14
@FLOW 1-3-4N-5-6-7N-12-13
@FLOW 4Y-14-15
@FLOW 7Y-17-13
@BOX 1.0
PROC BACKSPACE(UNIT)
@BOX 3.0
SEARCH UNIT TABLE
FOR THIS UNIT NUMBER
:5.8:
@BOX 4.0
EXTRACT STATUS
UNIT CLOSED OR
NOT ACCESSED YET ?
@BOX 5.0
SELECT INPUT STREAM
@BOX 6.0
IF LAST OP WAS A WRITE
   SET END FILE POSITION
@BOX 7.0
JUST READ OR WRITTEN ENDFILE ?
@BOX 12.0
BACKSPACE RECORD
@BOX 13.0
END
@BOX 14.0
FAULT 127
'INVALID UNIT NUMBER'
@BOX 15.0
END
@BOX 17.0
SELECT END UNIT POSITION IN STREAM
CLEAR ENDFILE CONDITION
@BOX 1.1
; PROC FIO.B.SPACE(UN)
; ADDR UNIT CUR
; $LO16 S
@BOX 3.1
; FIO.SEARCH.UNIT.TABLE(UN,%C) => CUR
@BOX 4.1
; IF STATUS OF CUR^ => S & %207 /= %205
@BOX 5.1
; SELECT.INPUT(STREAM.NO OF CUR^)
@BOX 6.1
;IF S & %400 /= 0 THEN
   ;SELECTOUTPUT(STREAM.NO OF CUR^)
   ;FIO.MARK.EOF()
   ;%FF7F &> STATUS OF CUR^
   ; SET.I.REC(I.REC())
   ; SET.I.POS(0)
;FI
@BOX 7.1
; IF S & %80 = %80
@BOX 12.1
;IF S & %20 /= 0 THEN
    ;IN.BACKSPACE(1)
    ;IN.BACKSPACE(-1)
 ;ELSE
   ;BACK.REC()
 ;FI
@BOX 13.1
END
@BOX 14.1
; ENTER.TRAP(6,127)
@BOX 15.1
EXIT
@BOX 17.1
; SET.I.REC(I.REC())
; SET.I.POS(0)
; %FF7F &> STATUS OF CUR^
@END
@TITLE FTN25.2(1,11)
@COL 1S-2R-3R-4F
@FLOW 1-2-3-4
@BOX 1.0
PROC ENDFILE(UNIT)
@BOX 2.0
SELECT.SEQ.UNIT
FOR WRITING
:7.2:
@BOX 3.0
MARK EOF :5.7:
@BOX 4.0
END
@BOX 1.1
; PROC FIO.ENDFILE(UNIT)
@BOX 2.1
; FIO.SELECT.SEQ.UNIT(UNIT,NIL.TBL,VOID,%B)
@BOX 3.1
; FIO.MARK.EOF()
@BOX 4.1
; 0 => REST.REQ
END
@END
@TITLE FTN25.3(1,11)
@COL 42R
@COL 1S-2R-3T-41T-6T-8R-40R-9F
@ROW 42-6
@FLOW 1-2-3N-41N-6N-8-40-9
@FLOW 3Y-9
@FLOW 41Y-42
@FLOW 6Y-40
@BOX 1.0
PROC REWIND(UNIT)
@BOX 2.0
SEARCH UNIT TABLE
FOR UNIT NUMBER
@BOX 6.0
SELECT INPUT AND OUTPUT STREAMS
LAST OPERATION NOT WRITE
@BOX 3.0
NOT FOUND ?
@BOX 41.0
DIRECT ACCESS?
@BOX 42.0
FAULT 122
'INVALID UNIT ACCESS'
@BOX 8.0
SET ENDFILE POSITION
@BOX 40.0
POSITION AT START OF FILE
MARK UNIT AS OPEN
CLEAR ENDFILE
CLEAR WRITE OPERATION
@BOX 9.0
END
@BOX 1.1
; PROC FIO.REWIND(UN)
; ADDR UNIT CUR
; $IN S
@BOX 2.1
; FIO.SEARCH.UNIT.TABLE(UN,%C) => CUR
@BOX 3.1
; SELECT CUR^
; IF STATUS => S & %201 /= %201
@BOX 6.1
; SELECT.INPUT(STREAM.NO)
; SELECT.OUTPUT(STREAM.NO)
; IF S & %400 = 0
@BOX 41.1
;IF S & 2 /= 0
@BOX 42.1
; ENTER.TRAP(6,122)
@BOX 8.1
; FIO.MARK.EOF()
@BOX 40.1
; SELECT.DOC()
; %200 !> STATUS
; %FB7F &> STATUS
@BOX 9.1
; 0 => REST.REQ
END
@END
@TITLE FTN25.4(1,11)
@COL 22T-23R-24R
@COL 1S-21R-42R-7R-2T-3T-18T-20R-40T-41T-12T-6R-8T-11T-5R-13R-17F
@COL 28T-29T-30R-33R-34C-37R
@ROW 3-28
@ROW 13-37
@ROW 22-11
@FLOW 1-21-42-7-2N-3Y-40N-41N-12N-6-8N-11N-5-13-17
@FLOW 2Y-28N-29N-30-3N-18N-20-6
@FLOW 40Y-37
@FLOW 41Y-6
@FLOW 12Y-37
@FLOW 18Y-37
@FLOW 8Y-22N-23-11Y-37
@FLOW 28Y-33-34
@FLOW 22Y-24-11
@FLOW 29Y-33
@BOX 1.0
OPEN(UNIT,FILE,STATUS,ACCESS,FORM,RECL,BLANK)
@BOX 21.0
VALIDATE PARAMETERS
@BOX 42.0
SEARCH UNIT TABLE
FOR UNIT NUMBER
OR VACANT ENTRY:5.8:
@BOX 2.0
UNIT OPEN AND ACCESSED?
@BOX 3.0
NOTE UNNAMED
STATUS NOT SCRATCH?
@BOX 40.0
STATUS = OLD OR NEW
AND FILENAME ABSENT?
@BOX 41.0
FILENAME ABSENT?
@BOX 12.0
NOTE IF FILE EXISTS
STATUS = OLD & NOT EXISTS
OR STATUS = NEW & EXISTS ?
@BOX 5.0
DEFINE IO STREAM FOR UNIT
@BOX 6.0
NOTE ACCESS
@BOX 7.0
REMOVE TRAILING SPACES FROM FILENAME
@BOX 8.0
FORM NOT DEFINED?
@BOX 11.0
DIRECT ACCESS AND
INVALID RECL ?
@BOX 13.0
NOTE FORM
NOTE RECL
NOTE BLANK
SET MAX RECORD POS FOR DA FILES
RESET DA ACCESS
NOTE UNIT IN USE
@BOX 17.0
END
@BOX 18.0
FILENAME
SPECIFIED?
@BOX 20.0
SET FILENAME = '*'
@BOX 22.0
DIRECT ACCESS?
@BOX 23.0
SET FORM=FMT
@BOX 24.0
SET FORM=UN FMT
@BOX 28.0
FILENAME NOT
SPECIFIED
@BOX 29.0
FILENAME NOT
DIFFERENT TO
THAT CONNECTED?
@BOX 30.0
CLOSE UNIT
@BOX 33.0
NOTE BLANK
@BOX 34.0
END
@BOX 37.0
FAULT
@BOX 1.1
; PROC FIO.OPEN(UN,FILE,STAT,ACCESS,FORM,RECL,BLANK,IO)
; $LO8 ST,AC,FO,BL,C,EXIST
; INTEGER I
; ADDR UNIT CUR
; $LO8[80] OFN
; ADDR[$LO8] PFN
@BOX 21.1
; FIO.STRIP.BLANKS(STAT) => STAT
; FIO.STRIP.BLANKS(ACCESS) => ACCESS
; FIO.STRIP.BLANKS(FORM)   => FORM
; FIO.STRIP.BLANKS(BLANK)  => BLANK
; IF STAT = VOID OR FIO.CH.COMP(STAT,^UNKNOWN) /= 0 THEN 0 => ST
 ELSE IF FIO.CH.COMP(STAT,%"OLD") /= 0 THEN 1 => ST
 ELSE IF FIO.CH.COMP(STAT,%"NEW") /= 0 THEN 2 => ST
 ELSE IF FIO.CH.COMP(STAT,%"SCRATCH") /= 0 THEN 3 => ST
 ELSE ENTER.TRAP(6,123) FI FI FI FI
; IF ACCESS = VOID OR FIO.CH.COMP(ACCESS,^SEQUENTIAL) /= 0 THEN 0 => AC
 ELSE IF FIO.CH.COMP(ACCESS,^DIRECT) /= 0 THEN 2 => AC
 ELSE ENTER.TRAP(6,123) FI FI
; IF FORM = VOID THEN 0 => FO
 ELSE IF FIO.CH.COMP(FORM,^FORMATTED) /= 0 THEN %20 => FO
 ELSE IF FIO.CH.COMP(FORM,^UNFORMATTED) /= 0 THEN %40 => FO
 ELSE ENTER.TRAP(6,123) FI FI FI
; IF BLANK = VOID OR FIO.CH.COMP(BLANK,^NULL) /= 0 THEN 0 => BL
 ELSE IF FIO.CH.COMP(BLANK,^ZERO) /= 0 THEN 1 => BL
 ELSE ENTER.TRAP(6,123) FI FI
@BOX 42.1
; FIO.SEARCH.UNIT.TABLE(UN,0) => CUR
@BOX 2.1
; SELECT CUR^
; UN => UNIT.NO
; IF STATUS & %201 = %201
@BOX 3.1
; IO => STATUS
; IF ST /= 3
@BOX 5.1
; DEFINE.IO(-1,PFN,0,MAX.SECTION.Z.L) => STREAM.NO
@BOX 40.1
; IF [ST = 1 OR ST = 2] AND FILE = VOID
@BOX 41.1
; IF FILE = VOID
@BOX 12.1
;IF CONNECT.FILE(PFN) => EXIST < 0 THEN
    0 => EXIST
 ELSE END.INPUT(EXIST,1); 1 => EXIST FI
; IF ST = 1 AND EXIST = 0 OR ST = 2 AND EXIST = 1
@BOX 7.1
; FIO.STRIP.BLANKS(FILE) => PFN
@BOX 6.1
; AC !> STATUS
@BOX 8.1
; IF FO = 0
@BOX 11.1
; IF AC = 2 AND RECL =< 0
@BOX 13.1
; FO !> STATUS
; IF RECL = 0 THEN
  ;IF FO & %40 /= 0 THEN
     ;%3FFF => RECORD.L
   ;ELSE
     ;120 => RECORD.L
  ;FI
;ELSE RECL => RECORD.L FI
; SELECT.OUTPUT(STREAM.NO)
; SELECT.INPUT(STREAM.NO)
; SET.I.REC(O.REC() => MAX.RECORD.POS)
; IF R.SIZE() => MAX.POS < 0 THEN
   ; 0 => MAX.POS
; FI
; SET.O.REC(MAX.RECORD.POS)
; IF BL = 0 THEN %100 !> STATUS  ELSE %FEFF &> STATUS FI
; %200 !> STATUS
; 1 => RECORD.NO
@BOX 17.1
; 0 => REST.REQ
END
@BOX 18.1
; IF FILE /= VOID
@BOX 20.1
; ^STAR => PFN
@BOX 22.1
; IF AC = 2
@BOX 23.1
; %20 => FO
@BOX 24.1
; %40 => FO
@BOX 28.1
; IF FILE = VOID
@BOX 29.1
; IF FIO.CH.COMP(PFN,FIO.FILE.NAME(CUR,^OFN)) = 0
@BOX 30.1
; FIO.CLOSE(UN,VOID)
@BOX 33.1
; IF BL = 0 THEN %100 !> STATUS
 ELSE %FEFF &> STATUS FI
@BOX 34.1
EXIT
@BOX 37.1
; ENTER.TRAP(6,123)
@END
@TITLE FTN25.5(1,11)
@COL 14R-15R
@COL 1S-42R-2T-3T-5T-8T-45T-46R-10R-32T-30R-11R-12F
@COL 13T-6R
@ROW 8-14
@ROW 15-10
@ROW 13-46
@FLOW 1-42-2N-3N-5N-8N-45N-46-10-32N-30-11-12
@FLOW 2Y-12
@FLOW 3Y-14
@FLOW 5Y-14
@FLOW 32Y-11
@FLOW 8Y-15-32
@FLOW 45Y-13N-6-10
@FLOW 13Y-46
@BOX 1.0
CLOSE (UNIT,STATUS)
@BOX 42.0
SEARCH UNIT TABLE
FOR UNIT NUMBER
:5.8:
@BOX 2.0
UNIT NOT OPEN?
@BOX 3.0
INVALID STATUS?
@BOX 5.0
SCRATCH FILE AND
STATUS=KEEP?
@BOX 6.0
NOTE SAVE OUTPUT
POSITION AT END OF FILE
@BOX 8.0
INPUT ONLY UNIT?
@BOX 13.0
NO WRITE ACCESS TO UNIT
AND FILE EXISTS
@BOX 45.0
STATUS = KEEP OR
NOT SPECIFIED
@BOX 46.0
NOTE DISCARD OUTPUT
@BOX 10.0
RELEASE OUTPUT
STREAM
@BOX 30.0
DELETE FILE
@BOX 11.0
MARK UNIT AS
CLOSED IN
UNIT TABLE
@BOX 12.0
END
@BOX 14.0
FAULT
'KEEP STATUS ON
A SCRATCH FILE'
@BOX 15.0
RELEASE
INPUT STREAM
@BOX 32.0
STATUS = KEEP OR NOT
SPECIFIED?
@BOX 1.1
; PROC FIO.CLOSE(UN,STAT)
; INTEGER ST,SAV
; ADDR UNIT CUR
; $LO8[80] FN
; $LO16 S
; ADDR [$LO8] FN.P
@BOX 42.1
; FIO.SEARCH.UNIT.TABLE(UN,0) => CUR
@BOX 2.1
; IF CUR = NIL OR
    STATUS OF CUR^ => S & %200 = 0
@BOX 3.1
; IF STAT = VOID THEN 0 => ST
 ELSE IF FIO.CH.COMP(FIO.STRIP.BLANKS(STAT) => STAT
,%"KEEP") /= 0
            THEN 1 => ST
 ELSE IF FIO.CH.COMP(STAT,%"DELETE") /= 0
             THEN 2 => ST
               ;FIO.FILE.NAME(CUR, ^FN) => FN.P
 ELSE -1 => ST FI FI FI
; SELECT CUR^
; IF ST < 0
@BOX 5.1
; IF STATUS & %800 /= 0 AND ST = 1
@BOX 13.1
; IF STATUS & %4000 = 0 AND MAX.POS /= 0
@BOX 6.1
; 1 => SAV
; SELECT.OUTPUT(STREAM.NO)
; SET.O.REC(MAX.RECORD.POS)
; SET.O.POS(MAX.POS)
@BOX 8.1
; IF S & %8 = 0
@BOX 45.1
; IF ST < 2
@BOX 46.1
; -1 => SAV
@BOX 10.1
; END.OUTPUT(STREAM.NO,SAV)
@BOX 30.1
; DELETE(FN.P)
@BOX 11.1
; %B9FF &> STATUS
@BOX 12.1
; 0 => REST.REQ
END
@BOX 14.1
; ENTER.TRAP(6,124)
@BOX 15.1
; END.INPUT(STREAM.NO,1)
@BOX 32.1
;IF ST < 2
@END
@TITLE FTN25.6(1,11)
@COL 7T-9R
@COL 1S-2T-42T-5R-6F
@COL 10R
@ROW 7-42
@ROW 9-5-10
@FLOW 1-2N-42N-5-6
@FLOW 2Y-7N-9-6
@FLOW 7Y-5
@FLOW 42Y-10-6
@BOX 1.0
INQUIRE (UNIT,FILE)
@BOX 2.0
INQUIRE BY FILE?
@BOX 42.0
SEARCH UNIT TABLE
FOR UNIT NUMBER
NOT FOUND ?
: 12.5.8:
@BOX 5.0
SET UNIT NUMBER
SET EXISTS
SET UNIT OPEN
SET ACCESS TYPE
SET RECORD FORMS
SET BLANK CONTROL
SET RECL
SET FILENAME
SET NEXT RECORD NO
@BOX 6.0
END
@BOX 7.0
FILE CONNECTED
TO A UNIT
@BOX 9.0
SET UNIT CLOSED
DISCOVER IF FILE EXISTS
@BOX 10.0
SET UNIT CLOSED
SET NOT EXISTS
SET NOT NAMED
@BOX 1.1
; PROC FIO.INQUIRE(UN,FILE)
; INTEGER I,K,SZ
; $LO8[80] FN
; ADDR UNIT CUR
; ADDR [$LO8] PFN
@BOX 2.1
; IF FILE /= VOID
@BOX 42.1
; FIO.SEARCH.UNIT.TABLE(UN,%C) => CUR
; IF CUR = NIL OR
        STATUS OF CUR^ & %200 = 0
@BOX 5.1
; CUR^ => IN.RES
; 1 !> STATUS OF IN.RES
; FIO.FILE.NAME(CUR,^IN.FILE.NAME) => IN.FILE.NAME.P
@BOX 6.1
; 0 => REST.REQ
END
#FTN25.6.1
#FTN25.6.2
#FTN25.6.3
#FTN25.6.4
#FTN25.6.5
#FTN25.6.6
#FTN25.6.7
#FTN25.6.8
#FTN25.6.9
#FTN25.6.10
#FTN25.6.11
#FTN25.6.12
#FTN25.6.13
#FTN25.6.14
@BOX 7.1
; FIO.STRIP.BLANKS(FILE) => PFN
; -1 => I
; NIL => CUR.UNIT
; WHILE 1+>I < UNIT.TABLE.SZ.L AND CUR.UNIT = NIL DO
; IF STATUS OF UNIT.TABLE[I] & %200 /= 0 AND
   FIO.CH.COMP(PFN,FIO.FILE.NAME(^UNIT.TABLE[I],^FN)) = 1 THEN
      ; ^UNIT.TABLE[I] => CUR.UNIT
   ; FI
; OD
; IF CUR.UNIT /= NIL
@BOX 9.1
; IF CONNECT.FILE(PFN) => I < 0 THEN
   ; 0 => STATUS OF IN.RES
; ELSE
   ; 1 => STATUS OF IN.RES
   ; SELECT.INPUT(I)
   ; FIO.FILE.NAME(^IN.RES,^IN.FILE.NAME) => IN.FILE.NAME.P
   ; END.INPUT(I,1)
; FI
@BOX 10.1
; 0 => STATUS OF IN.RES
@END
@TITLE FTN25.6.1(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
INQUIRE.EXIST
@BOX 2.0
EXTRACT FIRST BIT
OF STATUS
@BOX 3.0
END
@BOX 1.1
;PROC FIO.INQUIRE.EXIST
@BOX 2.1
;STATUS OF IN.RES & 1 => FIO.INQUIRE.EXIST
@BOX 3.1
END
@END
@TITLE FTN25.6.2(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
INQUIRE.OPENED
@BOX 2.0
EXTRACT 10TH BIT
OF STATUS
@BOX 3.0
END
@BOX 1.1
;PROC FIO.INQUIRE.OPENED
@BOX 2.1
;STATUS OF IN.RES & %200 ->> 9 => FIO.INQUIRE.OPENED
@BOX 3.1
END
@END
@TITLE FTN25.6.3(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
INQUIRE.NUMBER
@BOX 2.0
RETURN UNIT NUMBER
@BOX 3.0
END
@BOX 1.1
;PROC FIO.INQUIRE.NUMBER
@BOX 2.1
;UNIT.NO OF IN.RES => FIO.INQUIRE.NUMBER
@BOX 3.1
END
@END
@TITLE FTN25.6.4(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
INQUIRE.NAMED
@BOX 2.0
DISCOVER IF NAMED
@BOX 3.0
END
@BOX 1.1
;PROC FIO.INQUIRE.NAMED
; $LO16 C
@BOX 2.1
;(IF IN.FILE.NAME.P = VOID
      THEN 0 ELSE 1) => FIO.INQUIRE.NAMED
@BOX 3.1
END
@END
@TITLE FTN25.6.5(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
INQUIRE.NAME
@BOX 2.0
RETURN FILE NAME
@BOX 3.0
END
@BOX 1.1
;PROC FIO.INQUIRE.NAME
; $IN SZ
@BOX 2.1
; IN.FILE.NAME.P => FIO.INQUIRE.NAME
@BOX 3.1
END
@END
@TITLE FTN25.6.6(1,11)
@COL 1S-2T-3R-5F
@COL 4R
@ROW 3-4
@FLOW 1-2N-3-5
@FLOW 2Y-4-5
@BOX 1.0
INQUIRE.ACCESS
@BOX 2.0
DIRECT ACCESS?
@BOX 3.0
RETURN "SEQUENTIAL"
@BOX 4.0
RETURN "DIRECT"
@BOX 5.0
END
@BOX 1.1
;PROC FIO.INQUIRE.ACCESS
@BOX 2.1
;IF STATUS OF IN.RES & 2 /=0
@BOX 3.1
;^SEQUENTIAL => FIO.INQUIRE.ACCESS
@BOX 4.1
;^DIRECT => FIO.INQUIRE.ACCESS
@BOX 5.1
END
@END
@TITLE FTN25.6.7(1,11)
@COL 1S-2T-3T-4R-6F
@COL 7R-5R
@ROW 3-7
@ROW 4-5
@FLOW 1-2N-3N-4-6
@FLOW 2Y-7-6
@FLOW 3Y-5-6
@BOX 1.0
INQUIRE.SEQUENTIAL
@BOX 2.0
NOT EXIST ?
@BOX 3.0
SEQUENTIAL?
@BOX 4.0
RETURN "NO"
@BOX 5.0
RETURN "YES"
@BOX 6.0
END
@BOX 7.0
RETURN "UNKNOWN"
@BOX 1.1
;PROC FIO.INQUIRE.SEQUENTIAL
@BOX 2.1
;IF STATUS OF IN.RES & 1 = 0
@BOX 3.1
;IF STATUS OF IN.RES & 2 = 0
@BOX 4.1
;^NO => FIO.INQUIRE.SEQUENTIAL
@BOX 5.1
;^YES => FIO.INQUIRE.SEQUENTIAL
@BOX 6.1
END
@BOX 7.1
^UNKNOWN => FIO.INQUIRE.SEQUENTIAL
@END
@TITLE FTN25.6.8(1,11)
@COL 1S-2T-3T-4R-6F
@COL 7R-5R
@ROW 3-7
@ROW 4-5
@FLOW 1-2N-3N-4-6
@FLOW 2Y-7-6
@FLOW 3Y-5-6
@BOX 1.0
INQUIRE.DIRECT
@BOX 2.0
NOT EXIST?
@BOX 3.0
SEQUENTIAL?
@BOX 4.0
RETURN "YES"
@BOX 5.0
RETURN "NO"
@BOX 6.0
END
@BOX 7.0
RETURN "UNKNOWN"
@BOX 1.1
;PROC FIO.INQUIRE.DIRECT
@BOX 2.1
;IF STATUS OF IN.RES & 1 = 0
@BOX 3.1
;IF STATUS OF IN.RES & 2 = 0
@BOX 4.1
;^YES => FIO.INQUIRE.DIRECT
@BOX 5.1
;^NO => FIO.INQUIRE.DIRECT
@BOX 6.1
END
@BOX 7.1
^UNKNOWN => FIO.INQUIRE.DIRECT
@END
@TITLE FTN25.6.9(1,11)
@COL 1S-2R-3R-4F
@FLOW 1-2-3-4
@BOX 1.0
INQUIRE.FORM
@BOX 2.0
RETURN "DIRECT"
IF BIT SET
@BOX 3.0
RETURN "SEQUENTIAL"
IF BIT SET
@BOX 4.0
END
@BOX 1.1
;PROC FIO.INQUIRE.FORM
@BOX 2.1
;IF STATUS OF IN.RES & %40 /= 0 THEN
      ^DIRECT => FIO.INQUIRE.FORM
FI
@BOX 3.1
;IF STATUS OF IN.RES & %20 /=0 THEN
      ^SEQUENTIAL => FIO.INQUIRE.FORM
FI
@BOX 4.1
END
@END
@TITLE FTN25.6.10(1,11)
@COL 1S-2T-3T-4R-6F
@COL 7R-5R
@ROW 3-7
@ROW 4-5
@FLOW 1-2N-3N-4-6
@FLOW 2Y-7-6
@FLOW 3Y-5-6
@BOX 1.0
INQUIRE.FORMATTED
@BOX 2.0
FORMATTING UNKNOWN?
@BOX 3.0
FORMATTED?
@BOX 4.0
RETURN "NO"
@BOX 5.0
RETURN "YES"
@BOX 6.0
END
@BOX 7.0
RETURN "UNKNOWN"
@BOX 1.1
;PROC FIO.INQUIRE.FORMATTED
@BOX 2.1
;IF STATUS OF IN.RES & %60 = 0
@BOX 3.1
;IF STATUS OF IN.RES & %20 /= 0
@BOX 4.1
;^NO => FIO.INQUIRE.FORMATTED
@BOX 5.1
;^YES => FIO.INQUIRE.FORMATTED
@BOX 6.1
END
@BOX 7.1
;^UNKNOWN => FIO.INQUIRE.FORMATTED
@END
@TITLE FTN25.6.11(1,11)
@COL 1S-2T-3T-4R-6F
@COL 7R-5R
@ROW 3-7
@ROW 4-5
@FLOW 1-2N-3N-4-6
@FLOW 2Y-7-6
@FLOW 3Y-5-6
@BOX 1.0
INQUIRE.UNFORMATTED
@BOX 2.0
FORMATTING UNKNOWN?
@BOX 3.0
UNFORMATTED?
@BOX 4.0
RETURN "NO"
@BOX 5.0
RETURN "YES"
@BOX 6.0
END
@BOX 7.0
RETURN "UNKNOWN"
@BOX 1.1
;PROC FIO.INQUIRE.UNFORMATTED
@BOX 2.1
;IF STATUS OF IN.RES & %60 = 0
@BOX 3.1
;IF STATUS OF IN.RES & %40 /= 0
@BOX 4.1
;^NO => FIO.INQUIRE.UNFORMATTED
@BOX 5.1
;^YES => FIO.INQUIRE.UNFORMATTED
@BOX 6.1
END
@BOX 7.1
;^UNKNOWN => FIO.INQUIRE.UNFORMATTED
@END
@TITLE FTN25.6.12(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
INQUIRE.RECL
@BOX 2.0
RETURN RECORD LENGTH
@BOX 3.0
END
@BOX 1.1
;PROC FIO.INQUIRE.RECL
@BOX 2.1
;RECORD.L OF IN.RES => FIO.INQUIRE.RECL
@BOX 3.1
END
@END
@TITLE FTN25.6.13(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
INQUIRE.NEXTREC
@BOX 2.0
RETURN NEXT RECORD NUMBER
@BOX 3.0
END
@BOX 1.1
;PROC FIO.INQUIRE.NEXTREC
@BOX 2.1
;RECORD.NO OF IN.RES+1 => FIO.INQUIRE.NEXTREC
@BOX 3.1
END
@END
@TITLE FTN25.6.14(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
INQUIRE.BLANK
@BOX 2.0
RETURN "NULL" OR "ZERO"
@BOX 3.0
END
@BOX 1.1
;PROC FIO.INQUIRE.BLANK
@BOX 2.1
;IF STATUS OF IN.RES & %100 = 0 THEN ^ZERO => FIO.INQUIRE.BLANK
   ELSE ^NULL => FIO.INQUIRE.BLANK FI
@BOX 3.1
END
@END
@TITLE FTN25.7(1,11)
@COL 1S-2R-5F
@FLOW 1-2-5
@BOX 1.0
PROC MARK EOF
@BOX 2.0
NOTE ACCESSED
SET ENDFILE POSITION
NOTE ENDFILE STATUS
CLEAR WRITE OP STATUS
@BOX 5.0
END
@BOX 1.1
; PROC FIO.MARK.EOF
@BOX 2.1
; SELECT CUR.UNIT^
; O.REC() => MAX.RECORD.POS
; O.POS() => MAX.POS
; IF STATUS & %20 /= 0 THEN
   ; OUT.REC()
;FI
; END.POS()
; %4081 !> STATUS
; %FBFF &> STATUS
@BOX 5.1
END
@END
@TITLE FTN25.8(1,11)
@COL 4R-31R-32R
@COL 1S-2R-3T-5T-7T-6T-25T-9R-10T-12T-14T-15R-16R-18F
@COL 11R-13R-19T-20R
@ROW 5-4
@ROW 12-11
@ROW 15-19
@FLOW 1-2-3N-5N-7N-6N-25N-9-10N-12N-14N-15-16-18
@FLOW 3Y-4
@FLOW 5Y-16
@FLOW 6Y-16
@FLOW 25Y-4
@FLOW 7Y-31-32
@FLOW 10Y-11-12Y-13-14Y-19Y-16
@FLOW 19N-20-15
@BOX 1.0
SEARCH.UNIT.TABLE(UNIT,I/O)
@BOX 2.0
DECLARATIONS
@BOX 3.0
NEGATIVE UNIT NUMBER?
@BOX 4.0
FAULT 127
'INVALID UNIT NUMBER'
@BOX 5.0
SEARCH UNIT TABLE
FOR UNIT NUMBER
FOUND ?
@BOX 6.0
PRECONNECT INVALID?
@BOX 25.0
ILLEGAL PRECONNECT UNIT?
@BOX 7.0
FIND VACANT ENTRY
TABLE FULL?
@BOX 8.0
FAULT 128
'UNIT TABLE FULL'
@BOX 9.0
FIND FIRST POSSIBLE USE OF STREAM
FIND SECOND POSSIBLE USE OF STREAM
@BOX 10.0
INPUT NOT IN TABLE AND REQUESTED?
@BOX 11.0
CHECK INPUT STREAM
GET MODE
@BOX 12.0
OUTPUT NOT IN TABLE AND REQUESTED?
@BOX 13.0
CHECK OUTPUT STREAM
GET MODE
@BOX 14.0
EXTRACT FILE TYPE
STREAM NOT LOCATED?
@BOX 15.0
SAVE STREAM
 UNIT AND STATUS
IN UNIT TABLE
@BOX 16.0
SET CURRENT UNIT
@BOX 17.0
CLEAR CURRENT UNIT
@BOX 19.0
INPUT OUTPUT REQUEST?
@BOX 20.0
ASSIGN THE ORIGINAL INPUT OR
OUTPUT STREAM AS STORED FROM
THE INIT.RUN ROUTINE
@BOX 18.0
END
@BOX 31.0
FAULT 128
UNIT TABLE FULL
@BOX 32.0
ENTER TRAP
@BOX 1.1
; PROC FIO.SEARCH.UNIT.TABLE(UNIT,IO)
@BOX 2.1
; $IN32 K
; INTEGER I,J,L,U,NL,F
; $LO16 S

@BOX 3.1
; %100 !> REST.REQ
; IF UNIT < 0
@BOX 4.1
; 127 => F
@BOX 5.1
; 0 => I
; IF IO & %10 /= 0 THEN
     (IF IO & 8 /= 0 THEN STR0.OUT.L ELSE STR0.IN.L) => I
ELSE
; WHILE [UNIT.NO OF UNIT.TABLE[I] /= UNIT OR
        STATUS OF UNIT.TABLE[I] & %200 = 0] AND 1 +> I < UNIT.TABLE.SZ.L DO OD
FI
; IF I < UNIT.TABLE.SZ.L
@BOX 6.1
; IF IO = 0
@BOX 25.1
; IF UNIT => U >= UNIT.TABLE.SZ.L
@BOX 7.1
; 0 => I
; WHILE STATUS OF UNIT.TABLE[I] & %200 /= 0 AND 1+>I < UNIT.TABLE.SZ.L DO OD
; IF I >= UNIT.TABLE.SZ.L
@BOX 9.1
; %310 => S
; 0 => J => K => L
; WHILE [STREAM.NO OF UNIT.TABLE[J] /= U OR
     STATUS OF UNIT.TABLE[J] => K & %200 = 0] AND 1+>J < UNIT.TABLE.SZ.L DO OD
; IF J >= UNIT.TABLE.SZ.L THEN 0 => K FI
; WHILE 1+>J < UNIT.TABLE.SZ.L AND [STREAM.NO OF UNIT.TABLE[J] /= U OR
     STATUS OF UNIT.TABLE[J] => L & %200 = 0] DO OD
; IF J >= UNIT.TABLE.SZ.L THEN 0 => L FI
; K !> L
@BOX 10.1
; 0 => K
; IF L& %4 = 0 AND IO & %4 /= 0
@BOX 11.1
; SELECT.INPUT(U)
::CV    IF I.MODE(^FILE.NAME OF UNIT.TABLE[I])=>K /= 0 THEN
::MU     IF I.MODE() => K /= 0 THEN
        %4 !> S
::CV      ; PW4 => BYTES OF UNIT.TABLE[I]
; FI
@BOX 12.1
; IF L & %8 = 0 AND IO & %8 /= 0
@BOX 13.1
; SELECT.OUTPUT(U)
::CV   IF O.MODE(^FILE.NAME OF UNIT.TABLE[I]) => K /= 0 THEN
::MU IF O.MODE() => K /= 0 THEN
       %8 !> S
::CV   ;PW4 => BYTES OF UNIT.TABLE[I]
; FI
@BOX 14.1
; IF S & %C = 0 OR
    [S & %C = %C AND K & %20(7) = 0]
@BOX 15.1
; BEGIN
; SELECT UNIT.TABLE[I]
; S => STATUS
; UNIT => UNIT.NO
; U => STREAM.NO
; END
@BOX 16.1
; ^UNIT.TABLE[I] => CUR.UNIT
@BOX 17.1
; NIL => CUR.UNIT
@BOX 19.1
;IF IO = %C
@BOX 20.1
;IO !> S
;(IF IO = 4 THEN OIS ELSE OOS) => U
;135 => RECORD.L OF UNIT.TABLE[I]
@BOX 18.1
; CUR.UNIT => FIO.SEARCH.UNIT.TABLE
END
@BOX 31.1
; 128 => F
@BOX 32.1
; ENTER.TRAP(6,F)
@END
@TITLE FTN25.9(1,11)
@COL 1S-2T-3R-4T-5R-6F
@COL 7C
@ROW 6-7
@FLOW 1-2N-3-4N-5-6
@FLOW 2Y-7
@FLOW 4Y-7
@BOX 1.0
PROC CH.COMP
@BOX 2.0
STRINGS OF DIFFERENT SIZE
@BOX 3.0
FOR ALL OF THE STRING
@BOX 4.0
CHARACTERS DIFFERENT?
@BOX 5.0
END OF LOOP
@BOX 6.0
RETURN ONE
@BOX 7.0
RETURN ZERO
@BOX 1.1
; PROC FIO.CH.COMP(A,B)
; INTEGER I,J
@BOX 2.1
; IF SIZE(A) => I /= SIZE(B)
@BOX 3.1
; FOR J < I DO
@BOX 4.1
; IF A^[J] /= B^[J]
@BOX 5.1
 OD
@BOX 6.1
; 1 => FIO.CH.COMP
 END
@BOX 7.1
; 0 => FIO.CH.COMP
  EXIT
@END
@TITLE FTN25.10(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
PROC FILE.NAME(UNIT,^BUFFER)^FILE.NAME
@BOX 2.0
GENERATE DOCUMENT NAME OF
CURRENT UNIT
@BOX 3.0
END
@BOX 1.1
; PROC FIO.FILE.NAME(UN,BUF)
; $IN I, J, S
; ADDR [$LO8] FNP
; PSPEC C64($LO64,$LO8)
; PROC C64(L64,CH)
; $IN S
; $LO8 B
; IF L64 /= 0 THEN
   ; 64 => S
   ; WHILE 8 -> S >=0 DO
      ; IF L64 ->> S & %FF => B /= 0 THEN
         ; B => BUF^[1+>I]
      ; FI
   ; OD
   ; IF CH /=0 THEN
      ; CH => BUF^[1+>I]
   ; FI
; FI
; END
@BOX 2.1
; -1 => I
; SELECT UN^
; IF STATUS & %200 = 0 THEN
   ; VOID => FIO.FILE.NAME
; ELSE
   ; IF STATUS & %8 = 0 THEN
      ;CURRENT.INPUT() => S
      ; SELECT.INPUT(STREAM.NO)
      ; IDOC() => FNP
      ; 0 => PWW2
   ELSE
      ; CURRENT.OUTPUT() => S
      ; SELECT.OUTPUT(STREAM.NO)
      ; ODOC() => FN.P
   FI
   IF PW1 = 1 THEN
      ; PWW1 => PWW2
      ; 0 => PWW1
   FI
   ;C64 (PWW2,':)
   ;C64 (PWW1,'*)
   ;FOR J < SIZE(FN.P) DO
      ;FNP^[J] => BUF^[1+>I]
   ;OD
   ;IF I < 0 THEN
      ;VOID => FIO.FILE.NAME
   ;ELSE
      ;PART(BUF,0,I) => FIO.FILE.NAME
   ;FI
   ;IF STATUS & 8 = 0 THEN
      ;SELECT.INPUT(S)
   ;ELSE
      ;SELECT.OUTPUT(S)
   ;FI
; FI
@BOX 3.1
;END
@END
@TITLE FTN25.11(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
PROC STRIP BLANKS (STRING) STRING
@BOX 2.0
REMOVE TRAILING BLANKS FROM STRING
@BOX 3.0
END
@BOX 1.1
; PROC FIO.STRIP.BLANKS(STR)
; $IN I
@BOX 2.1
; SIZE(STR) => I
; WHILE 1 -> I > = 0 AND STR^[I] = SPACE.L DO OD
; IF I < 0 THEN
      ; VOID => FIO.STRIP.BLANKS
; ELSE
   ; PART (STR,0,I) => FIO.STRIP.BLANKS
; FI
@BOX 3.1
; END
@END

