@X @~
~L3 COUK1247
80
~V7 56 2 -5
~D10
~H                    MUSS
~
~
~D10
~H             FTN231
~D10
~MMANCHESTER UNIVERSITY  -  CONFIDENTIAL~
~
~
                                                            ISSUE 10~
~V9 -1
~P
~YFTN231
~V9 1
~S1~M~OFORTRAN 77 I/O LIBRARY IMPLEMENTATION DESCRIPTION
~S1~M~OSection 23~
~S1~OSection 23. Input Procedures
~S1~O1.1 General Description
~BThis section of the Library contains the input procedures which
implement the Fortran READ statements, possibly using the Formats
processed by the last section. Fortran input may be list-directed,
formatted or unformatted and the routines in this section perform
all three kinds of input. All input is made from the currently selected
input stream, which was selected by the unit control routines in
section 27.
~S1~O1.2 Non Standard Features
~BThe storage of Hollerith characters in an arithmetic variable
is no longer part of the Fortran Standard language, character
type variables being used instead. However, described in an
appendix to the Fortran 77 standard is a recommended method
of extension to include the Hollerith character feature. This
library will read characters using 'A' format into arithmetic
variables in the recommended manner. The maximum number of
characters that can be stored in such a variable is four.
~BUnformatted input is implementation dependent on the size
of each storage item. At present unformatted integers and
logicals are input as one storage unit, reals as two, complex
and double precision as four. Character strings are input in
byte units.
~S1~O2. Interfaces
~S1~O2.1 Section Interfaces Used~
~
   Section 21   (Configuration Section)~
   Section 27   (Unit Control Procedures)~
~S1~O2.2 Section Interface
~
Exported Scalars:~
   FMT.NEST~
   GRP.CNT~
   SCF~
   REP.CNT~
~
Exported Vectors:~
   FMT.STACK~
~
Library Procedures:~
   FIO.I.READ~
   FIO.R.READ~
   FIO.DP.READ~
   FIO.C.READ~
   FIO.L.READ~
   FIO.STR.READ~
   FIO.LD.I.READ~
   FIO.LD.R.READ~
   FIO.LD.DP.READ~
   FIO.LD.C.READ~
   FIO.LD.L.READ~
   FIO.LD.STR.READ~
   FIO.UF.I.READ~
   FIO.UF.R.READ~
   FIO.UF.DP.READ~
   FIO.UF.C.READ~
   FIO.UF.L.READ~
   FIO.UF.STR.READ~
   FIO.E.READ~
~S1~O3. Implementation
~S1~O3.1 Outline of operation
~S1~OTypical code sequences for READ statements~
~3
~T# 8
~
       READ(5,100)I,R~
   100 FORMAT(1X,I6,3X,F6.2)~
~
       Required code sequence~
~
   FIO.SELECT.SEQ.UNIT(5, Refn. to FORMAT 100,NIL,4)~
   FIO.I.READ() => I~
   FIO.R.READ() => R~
   FIO.E.READ()~
~
~
~
       READ(*,FMT = 101,IOSTAT=IFLT,END=10)J,S~
   101 FORMAT(1X,I6,3X,F6.2)~
~
       Required code sequence~
~
   FIO.SET.FLT.RESTART(2,LABEL)~
   FIO.SELECT.SEQ.UNIT(0, Refn. to FORMAT 101,NIL,%14)~
   FIO.I.READ() => J~
   FIO.R.READ() => S~
   FIO.E.READ()~
LABEL:    FIO.STATUS() => IFLT~
       IF IFLT < 0 THEN GO TO 10~
~
~
       READ(*)I,R~
~
       Required code sequence~
~
   FIO.SELECT.SEQ.UNIT(0,NIL,NIL,%16)~
   FIO.LD.I.READ(descriptor to I)~
   FIO.LD.R.READ(descriptor to R)~
   FIO.E.READ()~
~0
~BData is read as either formatted, list directed or unformatted
input. Once a control character has been read the line is extended if
necessary with spaces until input length is satisfied. Characters
after the end of a logical record are ignored. The FIO.E.READ is
required in case the format contains slashes, etc., and
to return the input/output status for the associated statement.
~S1~M~OFormatted Input
~
~
FIO.I.READ()INTEGER.RESULT~
~
FIO.R.READ()REAL.RESULT~
~
FIO.DP.READ()DOUBLE.PRECISION.RESULT~
~
FIO.C.READ(Desc. to Complex input item)~
~
FIO.L.READ()LOGICAL.RESULT~
~BAll the above procedures read according to the controlling Format
and yield a result.
~S1FIO.STR.READ(STRING)
~BReads input according to the controlling format and places a
character string at the location specified.
~S1FIO.E.READ()
~BThis procedure terminates input from the controlling format, and
sets the reply word to zero to indicate successful read.
~S1~M~OList Directed Input
~
~
FIO.LD.I.READ (Desc. to integer input item)~
~
FIO.LD.R.READ (Desc. to real input item)~
~
FIO.LD.DP.READ (Desc. to Double Precision input item)~
~
FIO.LD.C.READ (Desc. to Complex input item)~
~
FIO.LD.L.READ (Desc. to Logical input item)~
~
FIO.LD.STR.READ (Desc. to character input item)~
~BAll the above procedures read in a value and assign it to the
list item, unless it is a 'null' value in which case the list item
remains unchanged.
~S1~M~OUnformatted Input
~S1FIO.UF.I.READ()INTEGER.RESULT
~S1FIO.UF.R.READ()REAL.RESULT
~S1FIO.UF.DP.READ()DOUBLE.PRECISION.RESULT
~S1FIO.UF.C.READ(Desc. to Complex input item)
~S1FIO.UF.L.READ()LOGICAL.RESULT
~BAll the above procedures read one unformatted item of the
appropriate type and yield a result.
~S1FIO.UF.STR.READ(STRING)
~BReads an unformatted character string of the appropriate length
and places it in the location specified.
~BWhether an item is read under format or list directed control,
the item with redundant blanks removed is put into IBUF. One set of
routines can then be utilised for these two types of control.
~BIf it is under format control, the procedure FIO.GET.FORM.CONST() reads
the corresponding constant into the buffer and it returns the number
of characters stored in the buffer as a result. If the item is read
under list-directed control, the corresponding constant is read
into the buffer by the FIO.GET.LD.CONST() procedure which again returns
the number of characters in the constant as a result. In this case,
the data type is also buffered to enable the correct use of input
list items with repeat counts.
~BHaving buffered the constant, whether it is formatted or list-directed,
it is read from the buffer by one of the following procedures:~
~3
~T# 8
~
#FIO.READ.INT()     -    for an integer constant~
#FIO.READ.REAL()    -    for a real constant~
#FIO.READ.DP()      -    for a double precision constant~
#FIO.READ.LOGICAL() -    for a logical constant~
#FIO.READ.STRING()  -    for a string constant~
#FIO.READ.HOLL()    -    for a Hollerith string constant~
~BTo distinguish the type of an input item which has a preceding
repeat count then,~
~
(1) for complex items a '(' is attached to the start of the item~
    in IBUF.~
(2) for string items a ' is attached to the start of the item~
    in IBUF.~
~0
~
No special action is required since the above actions will ensure
'illegal character' faults on reading the item with an incorrect
list item type.~
~S1~O3.1.2 Internal Procedures
~
FIO.O.READ(IO.LIST)~
~
~BProcesses the current format until a field descriptor of type A,
I, D, E, F, G, H, L is encountered, however if the remaining part of
the input output list is empty a : field descriptor or the end of
the format will terminate processing.~
~
Parameter:-~
~
~MIO.LIST  -  0/1 IO.list   not empty/empty.~
~S1FIO.READ.INT(I.BUF.PTR,WIDTH,SIGN)INEGER~
~BReads an integer from I.BUF starting at I.BUF.PTR of WIDTH characters.
SIGN = 0 means sign is optional. SIGN = 1 means sign is prohibited.~
~S1FIO.READ.HOLL(WIDTH)HOLL
~BReads a Hollerith string constant from I.BUF of WIDTH characters.
~S1FIO.GET.FORM.CONST(I.BUF.PTR.BL.EDIT,EXP.WIDTH)ACT.WIDTH~
~BReads a formatted constant into I.BUF starting at I.BUF.PTR. Redundant
leading spaces and unedited other spaces are not put in IBUF. No
validation of the constant is performed.~
~3
~
Parameters:-~
~
BL.EDIT   -  bit 0 = 0 means replace non leading blanks by zeroes~
          -  bit 0 = 1 means no blank editing on non leading~
             blanks~
          -  bit 1 = 1 means leading blanks are significant~
          -  bit 1 = 0 means leading blanks are not significant~
EXP.WIDTH -  number of characters in input field~
ACT.WIDTH -  number of characters stored in I.BUF~
~0
~S1FIO.LD.CONST(I.BUF.PTR,TYPE)WIDTH
~BA constant with an optional preceding repeat count is read into
IBUF starting at I.BUF.PTR. The constant is not validated. An item
which is to be assigned a null value is indicated by a width = 0.~
~3
~
Parameters:-~
~
  TYPE   -  0 means ')' not allowed as value terminator~
         -  1 means ')' allowed as value terminator~
  WIDTH  -  no of characters in constant~
~0
~
FIO.READ.REAL(I.BUF.PTR,WIDTH,FRAC WIDTH)REAL~
~BReads a real constant from IBUF starting at IBUFPTR and consisting of WIDTH
characters. If there is no decimal point then FRAC.WIDTH specifies the
number of rightmost fractional digits.~
~
FIO.READ.SEPARATOR(CHAR)~
~BReads and checks for a value separator. SLASH set if '/' encountered.~
~3
~
  CHAR    current character.~
~
FIO.READ.LOGICAL(WIDTH)L~
~BReads in a logical constant from IBUF and of WIDTH characters.~
~
Parameters:-~
~
   WIDTH~
   L     1 - true~
         0 - False~
~
FIO.READ.STRING(I.BUF.WIDTH,S LIST.ITEM)~
~BCopies the string from IBUF to the list item with blank filling
to the right.~
~
Parameters:-~
~
    I.BUF.WIDTH - Length plus one of character string in IBUF~
    LIST.ITEM   - Descriptor to list item character variable.~
~S1FIO.READ.REPEAT.COUNT(CHAR)CHAR~
~BReads and checks for a valid repeat count from the current input
stream.~
~
Parameters:-~
~
Input    CHAR - current character prior to calling~
Output   CHAR - current character after calling~
~
FIO.READ.DP(WIDTH)DP~
~BReads a Double Precision constant from IBUF consisting of WIDTH characters.
~S1~O3.2 Data Structures
~
I.BUF         Input Buffer.~
ACT.WIDTH.1   for remembering repeat information~
ACT.WIDTH.2   for list directed input.~
~
SLASH         =1 means '/' encountered in list directed input~
BLK           =0 on input trailing blanks treated as zeroes~
              =1 on input trailing blanks ignored~
CCC           =0 carriage control char not encountered~
                 in current input record.~
              =1 CCC encountered.~
~0
~Y
~V9 -1
~P
~D15
~HFLOWCHARTS
~
~
~H                FTN231
~V9 -1
~F
@TITLE FTN23(1,11)
@COL 1S-2R-3R-4R-5R-6R-7R-9F
@FLOW 1-2-3-4-5-6-7-9
@BOX 1.0
INPUT SECTION
@BOX 2.0
[IMPORT FTN23/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
  FORMATTED INPUT
   FTN23.2: INTEGER READ
   FTN23.3: REAL    READ
   FTN23.4: DP      READ
   FTN23.5: COMPLEX READ
   FTN23.6: LOGICAL READ
   FTN23.7: STRING  READ
  LIST DIRECTED INPUT
   FTN23.20: INTEGER READ
   FTN23.21: REAL    READ
   FTN23.22: DP      READ
   FTN23.23: COMPLEX READ
   FTN23.24: LOGICAL READ
   FTN23.25: STRING  READ
  UNFORMATTED INPUT
   FTN23.30: INTEGER READ
   FTN23.31: REAL    READ
   FTN23.32: DP      READ
   FTN23.33: COMPLEX READ
   FTN23.34: LOGICAL READ
   FTN23.35: STRING  READ
   FTN23.8: END READ
  PROCS USED BY ABOVE
   FTN23.9:  OREAD
   FTN23.10: END RECORD
   FTN23.11: READ INTEGER FROM IBUF
   FTN23.12: READ HOLL FROM IBUF
   FTN23.13: GET FORM CONSTANT
   FTN23.14: GET LIST DIRECTED CONSTANT
   FTN23.15: READ REAL FROM IBUF
   FTN23.16: READ SEPARATOR FROM STRM
   FTN23.17: READ LOGICAL FROM IBUF
   FTN23.18: READ STRING FROM IBUF
   FTN23.19: READ REPEAT COUNT FROM STRM
   FTN23.26: READ DP FROM IBUF
@BOX 9.0
END
@BOX 2.1
#FTN23/1
;MODULE (FIO.I8.READ,FIO.I16.READ,FIO.I32.READ,
         FIO.L8.READ,FIO.L16.READ,FIO.L32.READ,
         FIO.R.READ,FIO.DP.READ,FIO.C.READ,FIO.STR.READ,
         FIO.LD.I32.READ,FIO.LD.R.READ,FIO.LD.DP.READ,
         FIO.LD.C.READ,FIO.LD.L32.READ,FIO.LD.STR.READ,
         FIO.UF.I32.READ,FIO.UF.R.READ,FIO.UF.DP.READ,
         FIO.UF.C.READ,FIO.UF.L32.READ,FIO.UF.STR.READ,
         FIO.E.READ,FMT.NEST,FMT.STACK,GRP.CNT,SCF,REP.CNT,
         FIO.LD.I16.READ,FIO.LD.L16.READ,
         FIO.UF.I16.READ,FIO.UF.L16.READ,
         FIO.LD.I8.READ,FIO.LD.L8.READ,
         FIO.UF.I8.READ,FIO.UF.L8.READ,FIO.I.READ,FIO.L.READ,
         COMPLEX);
@BOX 3.1
;TYPE COMPLEX IS $RE32 R,I
@BOX 4.1
;LITERAL/ADDR UNIT NIL =
@BOX 5.1
;*GLOBAL 5
;$IN ACT.WIDTH1,ACT.WIDTH2,FMT.NEST,GRP.CNT,SCF,REP.CNT,LD.REP.CNT
@BOX 6.1
;$LO8[I.BUF.SZ.L]IBUF
;$IN[FMT.NEST.LIMIT]FMT.STACK
;*GLOBAL 0
@BOX 7.1
;L.SPEC FIO.I8.READ()/$IN8
;L.SPEC FIO.I16.READ()/$IN16
;L.SPEC FIO.I32.READ()/$IN32
;L.SPEC FIO.I.READ($LO8)/$IN32
;L.SPEC FIO.L8.READ()/$LO8
;L.SPEC FIO.L16.READ()/$LO16
;L.SPEC FIO.L32.READ()/$LO32
;L.SPEC FIO.L.READ($LO8)/$LO32
;L.SPEC FIO.UF.I32.READ()/$IN32
;L.SPEC FIO.UF.I16.READ()/$IN16
;L.SPEC FIO.UF.I8.READ()/$LO8
;L.SPEC FIO.UF.L32.READ()/$LO32
;L.SPEC FIO.UF.L16.READ()/$LO16
;L.SPEC FIO.UF.L8.READ()/$LO8
;L.SPEC FIO.LD.I32.READ(ADDR $IN32)
;L.SPEC FIO.LD.I16.READ(ADDR $IN16)
;L.SPEC FIO.LD.I8.READ(ADDR $LO8)
;L.SPEC FIO.LD.L32.READ(ADDR $LO32)
;L.SPEC FIO.LD.L16.READ(ADDR $LO16)
;L.SPEC FIO.LD.L8.READ(ADDR $LO8)
;L.SPEC FIO.R.READ()/$RE32
;L.SPEC FIO.DP.READ()/$RE64
;L.SPEC FIO.C.READ(ADDR COMPLEX)
;L.SPEC FIO.STR.READ(ADDR[$LO8])
;L.SPEC FIO.LD.R.READ(ADDR $RE32)
;L.SPEC FIO.LD.DP.READ(ADDR $RE64)
;L.SPEC FIO.LD.C.READ(ADDR COMPLEX)
;L.SPEC FIO.LD.STR.READ(ADDR[$LO8])
;L.SPEC FIO.UF.R.READ()/$RE32
;L.SPEC FIO.UF.DP.READ()/$RE64
;L.SPEC FIO.UF.C.READ(ADDR COMPLEX)
;L.SPEC FIO.UF.STR.READ(ADDR[$LO8])
;L.SPEC FIO.E.READ()
;P.SPEC FIO.READ.HOLL($IN,$IN,$LO8)/$LO64
;P.SPEC FIO.OREAD($IN)
;P.SPEC FIO.END.I.REC()
;P.SPEC FIO.READ.INT($IN,$IN,$IN)/$IN32
;P.SPEC FIO.GET.FORM.CONST($IN,$IN,$IN)/$IN
;P.SPEC FIO.GET.LD.CONST($IN,$IN)/$IN
;P.SPEC FIO.READ.REAL($IN,$IN,$IN)/$RE32
;P.SPEC FIO.READ.SEPARATOR($IN)
;P.SPEC FIO.READ.LOGICAL($IN)/$LO
;P.SPEC FIO.READ.STRING($IN,ADDR[$LO8])
;P.SPEC FIO.READ.REPEAT.COUNT($IN)/$IN
;P.SPEC FIO.READ.DP($IN,$IN)/$RE64
#FTN23.2.1
#FTN23.2.2
#FTN23.2.3
#FTN23.6.1
#FTN23.6.2
#FTN23.6.3
#FTN23.20.2
#FTN23.24.1
#FTN23.24.2
#FTN23.30.2
#FTN23.34.1
#FTN23.34.2
#FTN23.2
#FTN23.3
#FTN23.4
#FTN23.5
#FTN23.6
#FTN23.7
#FTN23.20
#FTN23.20.1
#FTN23.21
#FTN23.22
#FTN23.23
#FTN23.24
#FTN23.25
#FTN23.30
#FTN23.30.1
#FTN23.31
#FTN23.32
#FTN23.33
#FTN23.34
#FTN23.35
#FTN23.8
#FTN23.9
#FTN23.10
#FTN23.11
#FTN23.12
#FTN23.13
#FTN23.14
#FTN23.15
#FTN23.16
#FTN23.17
#FTN23.18
#FTN23.19
#FTN23.26
@BOX 9.1
;*END
@END
@TITLE FTN23/1(1,11)
@COL 1S-2R-3R-4R-5R-6R-7F
@FLOW 1-2-3-4-5-6-7
@BOX 1.0
INPUT IMPORTS
@BOX 2.0
IMPORTED TYPE
@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 I.BUF.SZ.L, FMT.NEST.LIMIT,CONTROL.CHAR.Z.L,BYTE.PER.S.L,
   BITS.PER.S.L,BYTE.PER.D.L,BITS.PER.R.L

;IMPORT LITERAL $LO8 SPACE.L
;IMPORT LITERAL $RE32 RDLOG10.0,RD0.1,RD0.0,RD10.0,RD1.0,RDLOG0.1
;IMPORT LITERAL $RE64  RQLOG10.0,RQ0.1,RQ0.0,RQ10.0,RQ1.0,RQLOG0.1
;IMPORT LITERAL I8.SIZE.L,I16.SIZE.L,I32.SIZE.L,I64.SIZE.L,MAX.HOLL.Z.L
@BOX 4.1
;$LO8 I8
;$LO16 I16
;$LO32 I32
;$LO64 I64
;ADDR[$IN16] FMT.TBL
;ADDR PW0
;$IN CUR.FMT,SLASH,BLK,REC,POS.S
;$IN32 S.POS, E.POS, T.POS, C.POS, EOR.POS
;$IN REST.REQ
;UNIT IN.RES
;ADDR UNIT CUR.UNIT
@BOX 5.1
;$LO8[8] HOLL.ARRAY
;$IN[CONTROL.CHAR.Z.L]CONTROL.CHAR
@BOX 6.1
;L.SPEC IN.CH()/$IN
;L.SPEC END.OUTPUT($IN, $IN)
;L.SPEC END.INPUT($IN,$IN)
;L.SPEC EXP($RE32)/$RE32
;L.SPEC IN.BACKSPACE($IN)
;L.SPEC IN.BIN($IN)/$LO32
;L.SPEC DEXP($RE64)/$RE64
;L.SPEC ENTER.TRAP($IN, $IN)
;L.SPEC I.POS()/$IN32
;L.SPEC SET.I.POS($IN32)
@END
@TITLE FTN23.2(1,11)
@COL 1S-2R-4R-5T-6T-7R-8R
@COL 18R-20T-13R-14R-15T-16R-17F
@COL 22R-21R-10R
@ROW 6-18
@ROW 13-22
@ROW 10-16-8
@FLOW 1-2-4-5N-6N-7-4
@FLOW 5Y-18-20N-13-14-15N-16-17
@FLOW 20Y-22-21-15Y-10-17
@FLOW 6Y-8-17
@BOX 1.0
I.READ(STORAGE) INT
@BOX 2.0
DECLARATIONS
@BOX 4.0
PICK UP
FORMAT
@BOX 5.0
AI?
@BOX 6.0
DEFGHL?
@BOX 7.0
OREAD
:3.9
@BOX 8.0
FAULT
INCONSISTENT
FIELD DESCRIPTOR
@BOX 10.0
RC-1
@BOX 13.0
GET FORMATTED
CONSTANT:3.13
@BOX 18.0
PICK UP WIDTH
@BOX 20.0
A?
@BOX 22.0
GET FORMATTED
CONST :3.13:
@BOX 21.0
READ HOLL
FROM IBUF
@BOX 14.0
READ INT FROM
IBUF
@BOX 15.0
RC SPECIFIED?
@BOX 16.0
NEXT FORMAT
@BOX 17.0
END
@BOX 1.1
;PROC FIO.I.READ(STORAGE)
@BOX 2.1
;$IN32 INT
;INTEGER FD,EXP.WIDTH,N,WIDTH
@BOX 4.1
;FMT.TBL^[CUR.FMT] => FD
@BOX 5.1
;IF FD = 1 OR FD = 2
@BOX 6.1
;IF FD >= 0
@BOX 7.1
;FIO.O.READ(0)
@BOX 8.1
;ENTER.TRAP(6,101)
@BOX 10.1
;1 -> REP.CNT
@BOX 13.1
;FIO.GET.FORM.CONST(0,BLK,EXP.WIDTH) => WIDTH
@BOX 20.1
; IF FD = 2
@BOX 21.1
; FIO.READ.HOLL(0,WIDTH,STORAGE) => INT
; 2 => N
@BOX 14.1
;FIO.READ.INT(0,WIDTH,0) => INT
; 3 => N
@BOX 18.1
;FMT.TBL^[CUR.FMT+1] => EXP.WIDTH
@BOX 22.1
; IF EXP.WIDTH = 0 THEN STORAGE => EXP.WIDTH FI
; FIO.GET.FORM.CONST(0,3,EXP.WIDTH) => WIDTH
@BOX 15.1
;IF REP.CNT /= 0
@BOX 16.1
;N +> CUR.FMT
@BOX 17.1
;INT => FIO.I.READ
END
@END
^L@TITLE FTN23.2.1(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
FIO.I8.READ
@BOX 2.0
CALL FIO.I.WRITE(I8.SIZE.L)
@BOX 3.0
END
@BOX 1.1
;PROC FIO.I8.READ
@BOX 2.1
;FIO.I.READ(I8.SIZE.L) => FIO.I8.READ
@BOX 3.1
;END
@END
^L@TITLE FTN23.2.2(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
FIO.I16.READ
@BOX 2.0
CALL FIO.I.READ(I16.SIZE.L)
@BOX 3.0
END
@BOX 1.1
;PROC FIO.I16.READ
@BOX 2.1
;FIO.I.READ(I16.SIZE.L) => FIO.I16.READ
@BOX 3.1
;END
@END
^L@TITLE FTN23.2.3(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
FIO.I32.READ
@BOX 2.0
CALL FIO.I.READ(I32.SIZE.L)
@BOX 3.0
END
@BOX 1.1
;PROC FIO.I32.READ
@BOX 2.1
;FIO.I.READ(I32.SIZE.L) => FIO.I32.READ
@BOX 3.1
;END
@END
@TITLE FTN23.3(1,11)
@COL 1S-3R-4T-6T-7R-8R
@COL 12R-20T-13R-14R-15T-16R-17F
@COL 22R-21R-18R
@ROW 6-12
@ROW 16-18
@ROW 13-22
@FLOW 1-3-4N-6N-7-3
@FLOW 4Y-12-20N-13-14-15N-16-17
@FLOW 20Y-22-21-15Y-18-17
@FLOW 6Y-8-17
@BOX 1.0
PROC R.READ
@BOX 3.0
PICK UP FORMAT
@BOX 4.0
ADEFG ?
@BOX 6.0
HIL?
@BOX 7.0
OREAD
:3.9
@BOX 8.0
FAULT
WRONG FIELD
DESCRIPTOR.
@BOX 12.0
PICK UP WIDTH
@BOX 13.0
GET FORMATTED
CONST:3.13
@BOX 20.0
A?
@BOX 22.0
GET FORMATTED
CONST :3.13:
@BOX 21.0
READ HOLL :3.12:
@BOX 14.0
READ REAL:3.15
@BOX 15.0
RC SPECIFIED?
@BOX 16.0
NEXT FORMAT
@BOX 18.0
RC-1
@BOX 17.0
END
@BOX 1.1
;PROC FIO.R.READ
;INTEGER FD,EXP.WIDTH,N,WIDTH
;$RE32 RES
@BOX 3.1
;FMT.TBL^[CUR.FMT] => FD
@BOX 4.1
;IF FD >= 4 AND FD =< 6 OR FD = 2
@BOX 6.1
;IF FD >= 0
@BOX 7.1
;FIO.O.READ(0)
@BOX 8.1
;ENTER.TRAP(6,101)
@BOX 12.1
;FMT.TBL^[CUR.FMT+1] => EXP.WIDTH
@BOX 22.1
; IF EXP.WIDTH = 0 THEN BYTE.PER.S.L => EXP.WIDTH FI
; FIO.GET.FORM.CONST(0,3,EXP.WIDTH) => WIDTH
@BOX 13.1
;FIO.GET.FORM.CONST(0,BLK,EXP.WIDTH) => WIDTH
@BOX 20.1
; IF FD = 2
@BOX 21.1
; FIO.READ.HOLL(0,WIDTH,I32.SIZE.L) => RES
; 2 => N
@BOX 14.1
;FIO.READ.REAL(0,WIDTH,FMT.TBL^[CUR.FMT+2]) => RES
; 4 => N
@BOX 15.1
;IF REP.CNT /= 0
@BOX 16.1
;N +> CUR.FMT
@BOX 18.1
; 1 -> REP.CNT
@BOX 17.1
;RES => FIO.R.READ
END
@END
@TITLE FTN23.4(1,11)
@COL 1S-3R-4T-6T-7R-8R
@COL 9R-10C-12R-20T-13R-14R-15T-16R-17F
@COL 22R-21R-18R
@ROW 13-22
@ROW 16-18
@FLOW 1-3-4N-6N-7-3
@FLOW 4Y-12-20N-13-14-15N-16-17
@FLOW 20Y-22-21-15
@FLOW 15Y-18-17
@FLOW 6Y-8-17
@BOX 1.0
PROC DP.READ
@BOX 3.0
PICK UP FORMAT
@BOX 4.0
ADEFG?
@BOX 6.0
HIL?
@BOX 7.0
OREAD:3.9
@BOX 8.0
FAULT
WRONG FIELD
DESCRIPTOR
@BOX 12.0
SET UP WIDTH
@BOX 13.0
GET FORMATTED
CONS:3.13
@BOX 14.0
READ DP.REAL:3.26.
@BOX 15.0
RC SPECIFIED?
@BOX 16.0
NEXT FORMAT
@BOX 18.0
RC-1
@BOX 17.0
FINISH
@BOX 20.0
A?
@BOX 21.0
READ.HOLL:23.12:
@BOX 22.0
GET FORMATTED
CONST:23.13:
@BOX 1.1
;PROC FIO.DP.READ
;$IN FD,EXP.WIDTH,N,WIDTH,STORAGE
@BOX 3.1
;FMT.TBL^[CUR.FMT] => FD
@BOX 4.1
;IF FD >= 4 AND FD =< 6 OR FD=2
@BOX 6.1
;IF FD >= 0
@BOX 7.1
;FIO.O.READ(0)
@BOX 8.1
;ENTER.TRAP(6,101)
@BOX 12.1
;FMT.TBL^[CUR.FMT+1] => EXP.WIDTH
@BOX 13.1
;FIO.GET.FORM.CONST(0,BLK,EXP.WIDTH) => WIDTH
@BOX 14.1
;FIO.READ.DP(WIDTH,FMT.TBL^[CUR.FMT+2]) => FIO.DP.READ
;4=>N
@BOX 15.1
;IF REP.CNT /= 0
@BOX 16.1
;N +> CUR.FMT
@BOX 18.1
1 -> REP.CNT
@BOX 17.1
END
@BOX 20.1
;IF FD=2
@BOX 21.1
;FIO.READ.HOLL(0,WIDTH,(IF WIDTH =< BYTE.PER.SL THEN
   I32.SIZE.L ELSE I64.SIZE.L))
; 2 =>N
@BOX 22.1
;IF EXP.WIDTH=0 THEN BYTE.PER.D.L => EXP.WIDTH FI
; FIO.GET.FORM.CONST(0,3,EXP.WIDTH) => WIDTH
@END
@TITLE FTN23.5(1,6)
@COL 1S-5R-6R-8F
@FLOW 1-5-6-8
@BOX 1.0
PROC CREAD
@BOX 5.0
R.READ:3.3:
REAL
@BOX 6.0
R.READ:3.3:
IMAG
@BOX 8.0
FINISH
@BOX 1.1
;PROC FIO.C.READ(C)
@BOX 5.1
;FIO.R.READ() => R OF C^
@BOX 6.1
;FIO.R.READ() => I OF C^
@BOX 8.1
END
@END
@TITLE FTN23.6(1,11)
@COL 1S-4R-5T-6T-7R-8R
@COL 12R-20T-13R-14R-15T-16R-18F
@COL 22R-21R-17R
@ROW 6-12
@ROW 16-17
@ROW 13-22
@FLOW 1-4-5N-6N-7-4
@FLOW 5YES-12-20N-13-14-15N-16-18
@FLOW 6YES-8-18
@FLOW 20YES-22-21-15YES-17-18
@BOX 1.0
L.READ(STORAGE)L
@BOX 3.0
UNFORMATTED?
@BOX 4.0
PICK-UP FORMAT
@BOX 5.0
AL?
@BOX 6.0
NOT
DEFGHI?
@BOX 7.0
OREAD:3.9
@BOX 8.0
FAULT
'WRONG FIELD
DESCRIPTOR'
@BOX 12.0
PICK UP
WIDTH
@BOX 20.0
A?
@BOX 13.0
GET FORMATTED
CONSTANT:3.13:
@BOX 14.0
READ LOGICAL
:3.17
@BOX 15.0
RC SPECIFIED?
@BOX 16.0
NEXT FORMAT
@BOX 17.0
DECREMENT RC
@BOX 18.0
END
@BOX 22.0
GET FORMATTED
CONSTANT :3.13:
@BOX 21.0
READ HOLL :3.12:
@BOX 1.1
;PROC FIO.L.READ(STORAGE)
;INTEGER FD,EXP.WIDTH,WIDTH
;LOGICAL L
@BOX 3.1
;IF CUR.FMT < 0
@BOX 4.1
;FMT.TBL^[CUR.FMT] => FD
@BOX 5.1
;IF FD = 3 OR FD = 2
@BOX 6.1
;IF FD >= 0
@BOX 7.1
;FIO.O.READ(0)
@BOX 8.1
;ENTER.TRAP(6,101)
@BOX 12.1
;FMT.TBL^[CUR.FMT+1] => EXP.WIDTH
@BOX 22.1
; IF EXP.WIDTH = 0 THEN STORAGE => EXP.WIDTH FI
; FIO.GET.FORM.CONST(0,3,EXP.WIDTH) => WIDTH
@BOX 13.1
;FIO.GET.FORM.CONST(0,BLK,EXP.WIDTH) => WIDTH
@BOX 20.1
; IF FD = 2
@BOX 21.1
; FIO.READ.HOLL(0,WIDTH,STORAGE) => L
@BOX 14.1
;FIO.READ.LOGICAL(WIDTH) => L
@BOX 15.1
;IF REP.CNT /= 0
@BOX 16.1
;2 +> CUR.FMT
@BOX 17.1
;1 -> REP.CNT
@BOX 18.1
;L => FIO.L.READ
END
@END
^L@TITLE FTN23.6.1(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
FIO.L8.READ
@BOX 2.0
CALL FIO.L.READ(I8.SIZE.L)
@BOX 3.1
END
@BOX 1.1
;PROC FIO.L8.READ
@BOX 2.1
;FIO.L.READ(I8.SIZE.L) => FIO.L8.READ
@BOX 3.1
;END
@END
^L@TITLE FTN23.6.2(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
FIO.L16.READ
@BOX 2.0
CALL FIO.L.READ(I16.SIZE.L)
@BOX 3.1
END
@BOX 1.1
;PROC FIO.L16.READ
@BOX 2.1
;FIO.L.READ(I16.SIZE.L) => FIO.L16.READ
@BOX 3.1
;END
@END
^L@TITLE FTN23.6.3(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
FIO.L32.READ
@BOX 2.0
CALL FIO.L.READ(I32.SIZE.L)
@BOX 3.1
END
@BOX 1.1
;PROC FIO.L32.READ
@BOX 2.1
;FIO.L.READ(I32.SIZE.L) => FIO.L32.READ
@BOX 3.1
;END
@END
@TITLE FTN23.7(1,6)
@COL 1S-3R-4T-5T-6R-7R
@COL 9R-10T-11R-12R-13R-14T-15R-17F
@COL 16R
@ROW 5-9
@ROW 15-16
@FLOW 1-3-4N-5N-6-3-4Y-9-10N-11-12-13-14N-15-17
@FLOW 5Y-7-17
@FLOW 10Y-12-13-14Y-16-17
@BOX 1.0
STR.READ(S CHAR STRING)
@BOX 3.0
PICK UP FORMAT
@BOX 4.0
A?
@BOX 5.0
DEFGHIL?
@BOX 6.0
OREAD
:3.9
@BOX 7.0
FAULT
'WRONG FORMAT
DESCRIPTOR'
@BOX 9.0
PICK UP WIDTH
@BOX 10.0
IS WIDTH /= 0?
@BOX 11.0
SET WIDTH FROM
CHAR STRING
@BOX 12.0
GET FORMATTED
CONSTANT:3.13
@BOX 13.0
READ CHARACTER
:3.18
@BOX 14.0
RC SPECIFIED?
@BOX 15.0
NEXT FORMAT
@BOX 16.0
DECREMENT RC
@BOX 17.0
END
@BOX 1.1
;PROC FIO.STR.READ(STRING)
;INTEGER EXP.WIDTH,WIDTH,FD
@BOX 3.1
;FMT.TBL^[CUR.FMT] => FD
@BOX 4.1
;IF FD = 2
@BOX 5.1
;IF FD >= 0
@BOX 6.1
;FIO.O.READ(0)
@BOX 7.1
;ENTER.TRAP(6,101)
@BOX 9.1
;FMT.TBL^[CUR.FMT+1] => EXP.WIDTH
@BOX 10.1
;IF EXP.WIDTH /= 0
@BOX 11.1
;SIZE(STRING) => EXP.WIDTH
@BOX 12.1
;FIO.GET.FORM.CONST(1,3,EXP.WIDTH) => WIDTH
@BOX 13.1
;FIO.READ.STRING(WIDTH,STRING)
@BOX 14.1
;IF REP.CNT /= 0
@BOX 15.1
;2 +> CUR.FMT
@BOX 16.1
1 -> REP.CNT
@BOX 17.1
END
@END
@TITLE FTN23.8(1,11)
@COL 1S-11T-10T-5R-7R-20T-21R-30R-9F
@FLOW 1-11N-10NO-5-7-20N-21-30-9
@FLOW 10YES-7
@FLOW 20Y-30
@FLOW 11Y-7
@BOX 1.0
PROC EREAD
@BOX 20.0
EXTERNAL FILE?
@BOX 21.0
RELEASE STREAM FOR INTERNAL FILE
@BOX 10.0
FD NOT NEG?
@BOX 5.0
OREAD:3.8:
NO IO LIST
@BOX 7.0
END RECORD
@BOX 30.0
RESET TRAPS
@BOX 9.0
SET PW0 = ZERO
FINISH
@BOX 11.0
LIST DIR OR
UNFORMATTED INPUT ?
@BOX 1.1
;PROC FIO.E.READ
@BOX 20.1
; IF CUR.UNIT /= NIL
@BOX 21.1
; END.OUTPUT(STREAM.NO OF IN.RES,0)
@BOX 10.1
;IF FMT.TBL^[CUR.FMT] >= 0
@BOX 5.1
;FIO.O.READ(1)
@BOX 7.1
;FIO.END.I.REC()
@BOX 30.1
;0 => REST.REQ
@BOX 9.1
; %FBFF &> STATUS OF CUR.UNIT^
; 1 !> STATUS OF CUR.UNIT^
;0 => PW0
END
@BOX 11.1
;IF CUR.FMT < 0
@END
@TITLE FTN23.9(1,11)
@COL 1S-5R-6R-7R-9R-17R-24R-10R-11R-12R
@COL 13R-14R-15R-16R-3R-22R-19R-20T-21F
@ROW 5-13
@FLOW 1-5-6-7-9-17-24-10-11-12-13-14-15-16-3-22-19-20N-21
@FLOW 20YES-6
@BOX 1.0
PROC OREAD
@BOX 5.0
NOTE FORMAT
POSITION
@BOX 6.0
PICK UP
DESCRIPTOR
@BOX 7.0
SWITCH
ON DESC
@BOX 9.0
SP,SS
@BOX 10.0
REPEAT
COUNT
@BOX 11.0
SLASHES:3.9.3:
@BOX 12.0
SCALE
FACTOR
@BOX 13.0
START FORMAT:3.9.4:
@BOX 14.0
END FORMAT:3.9.5:
@BOX 15.0
START GROUP
@BOX 16.0
END GROUP:3.9.6:
@BOX 3.0
S,SP,SS
@BOX 17.0
X,TR,TL,T
:3.9.7
@BOX 24.0
COLON:3.9.8
@BOX 22.0
RTN
PT
@BOX 19.0
NEXT FORMAT
@BOX 20.0
OREAD?
@BOX 21.0
FINISH
@BOX 1.1
;PROC FIO.O.READ(NO.IO.LIST)
;INTEGER F.PTR,FD,N,WIDTH,CHAR,PTR,CNT
;$IN32 POS
@BOX 5.1
;CUR.FMT => F.PTR
@BOX 6.1
; 2 => N
;-1-FMT.TBL^[CUR.FMT] => FD
@BOX 7.1
;SWITCH FD \
    START.FORMAT,
    END.FORMAT,
    START.GROUP,
    END.GROUP,
    REPEAT.COUNT,
    SCALE.FACTOR,
       X,
    SP.SS,
    SLASHES,
    S.SP.SS,
    COLON,
    TR,
    TL,
    T
@BOX 9.1
;SP.SS: FMT.TBL^[CUR.FMT+1] => BLK
; -> RTN.PT
@BOX 10.1
;REPEAT.COUNT : FMT.TBL^[CUR.FMT+1] => REP.CNT
; -> RTN.PT
@BOX 11.1
#FTN23.9.3
@BOX 12.1
;SCALE.FACTOR : FMT.TBL^[CUR.FMT+1] => SCF
;-> RTN.PT
@BOX 13.1
#FTN23.9.4
@BOX 14.1
#FTN23.9.5
@BOX 15.1
;START.GROUP : GRP.CNT => FMT.STACK[FMT.NEST]
; 0 => GRP.CNT
; 1 +> FMT.NEST
;-> RTN.PT
@BOX 3.1
;S.SP.SS : FMT.TBL^[CUR.FMT+1] => POS.S
@BOX 16.1
#FTN23.9.6
@BOX 17.1
#FTN23.9.7
@BOX 24.1
#FTN23.9.8
@BOX 22.1
;RTN.PT:
@BOX 19.1
;N +> CUR.FMT
@BOX 20.1
;IF FMT.TBL^[CUR.FMT] < 0
@BOX 21.1
END
@END
@TITLE FTN23.9.3(1,11)
@COL 1S-10C-8R-9C
@FLOW 1-10-8-9
@BOX 1.0
PROC OREAD: SLASHES
@BOX 10.0
SKIP
@BOX 8.0
END RECORD
START NEXT RECORD
@BOX 9.0
RTN
PT
@BOX 1.1
;SLASHES :
; 1 => N
@BOX 10.1
;SKIP.EOL:
@BOX 8.1
;FIO.END.I.REC()
;I.POS() => S.POS => T.POS => C.POS + REC => E.POS => EOR.POS
@BOX 9.1
;-> RTN.PT
@END
@TITLE FTN23.9.4(1,11)
@COL 1S-3R-6C
@FLOW 1-3-6
@BOX 1.0
PROC OREAD:START FORMAT
@BOX 3.0
ZERO SCALE FACTOR
REPEAT COUNTS
@BOX 6.0
RTN
PT
@BOX 1.1
;START.FORMAT:
@BOX 3.1
;0 => SCF => REP.CNT => FMT.NEST
@BOX 6.1
; -> RTN.PT
@END
@TITLE FTN23.9.5(1,6)
@COL 1S-7T-3R-4T-5R-10R-6C
@COL 50A-8C
@ROW 3-8
@FLOW 1-7NO-3-4NO-5-10-6
@FLOW 7YES-8
@FLOW 4YES-10
@BOX 50.0
FTN23.9.5
@BOX 1.0
PROC OREAD : END OF FORMAT
@BOX 7.0
NO IO LIST?
@BOX 3.0
MOVE BACK PTR
@BOX 4.0
BEFORE
STARTING
POS?
@BOX 5.0
FAULT
'NO FIELD
DESCRIPTOR'
@BOX 10.0
MOVE STARTING
POSITION
@BOX 6.0
SKIP
@BOX 8.0
EXIT
@BOX 1.1
;END.FORMAT:
@BOX 7.1
;IF NO.IO.LIST = 1
@BOX 3.1
;IF FMT.TBL^[FMT.TBL^[CUR.FMT+1] => CUR.FMT] = -3 THEN 0 => N FI
@BOX 4.1
;IF CUR.FMT < F.PTR
@BOX 5.1
;ENTER.TRAP(6,105)
@BOX 10.1
;CUR.FMT => F.PTR
@BOX 8.1
EXIT
@BOX 6.1
; -> SKIP.EOL
@END
@TITLE FTN23.9.6(1,6)
@COL 1S-3T-4R-5R-6C
@COL 7R
@ROW 4-7
@FLOW 1-3NO-4-5-6
@FLOW 3YES-7-6
@BOX 1.0
PROC OREAD : END OF GROUP
@BOX 3.0
END OF LOOP?
@BOX 4.0
INCREMENT COUNT
@BOX 5.0
MOVE BACK PTR
@BOX 6.0
RTN
PT
@BOX 7.0
UNSTACK GROUP COUNT
@BOX 1.1
;END.GROUP:
@BOX 3.1
;IF FMT.TBL^[FMT.TBL^[CUR.FMT+1] => PTR+1] = GRP.CNT
@BOX 4.1
; 1 +> GRP.CNT
@BOX 5.1
;PTR => CUR.FMT
@BOX 6.1
; -> RTN.PT
@BOX 7.1
FMT.STACK[1->FMT.NEST] => GRP.CNT
@END


@TITLE FTN23.9.7(1,11)
@COL 1S-2R-9C-10R-3C-4R-5T-6R-7R-8C
@COL 11T-12R
@ROW 11-6
@FLOW 1-2-5N-6-7-8
@FLOW 5Y-11N-12-7
@FLOW 3-4-5
@FLOW 9-10-5
@FLOW 11Y-7
@BOX 1.0
PROC OWRITE
T
@BOX 2.0
SET REQUIRED POSITION
@BOX 3.0
X,TR
@BOX 4.0
SET REQUIRED POSITION
@BOX 5.0
REQUIRED POSITION NOT PAST
TIDEMARK
@BOX 6.0
SET MUSS POSITION TO TIDEMARK
@BOX 7.0
SET MUSS POSITION
@BOX 8.0
END
@BOX 9.0
TL
@BOX 10.0
SET REQUIRED POSITION
@BOX 11.0
REQUIRED POSITION WITHIN RECORD
@BOX 12.0
SET REQUIRED POSITION TO START OF RECORD
@BOX 1.1
;T:
@BOX 2.1
;FMT.TBL^[1+CUR.FMT] + S.POS -1 => C.POS
@BOX 3.1
;X:
;T.R:
@BOX 4.1
;FMT.TBL^[1+CUR.FMT] +> C.POS
@BOX 5.1
;IF C.POS => POS =< T.POS
@BOX 6.1
;T.POS => POS
@BOX 7.1
;SET.I.POS(POS)
@BOX 8.1
;-> RTN.PT
@BOX 9.1
;TL:
@BOX 10.1
;FMT.TBL^[1+CUR.FMT] -> C.POS
@BOX 11.1
;IF C.POS >= S.POS
@BOX 12.1
;S.POS => C.POS => POS
@END
@TITLE FTN23.9.8(1,6)
@COL 1S-2T-3C
@COL 4F
@ROW 3-4
@FLOW 1-2N-3
@FLOW 2Y-4
@BOX 1.0
OREAD:COLON
@BOX 2.0
NO IO LIST?
@BOX 3.0
RTN
@BOX 4.0
EXIT
@BOX 1.1
;COLON:
@BOX 2.1
;IF NO.IO.LIST /= 0
@BOX 3.1
;1 => N
;-> RTN.PT
@BOX 4.1
EXIT
@END
@TITLE FTN23.10(1,11)
@COL 8R
@COL 1S-11T-2T-3T-4T-5T-6R-7F
@COL 9R-10R
@ROW 3-9
@ROW 8-6
@FLOW 1-11N-2N-3N-4N-5N-6-7
@FLOW 2Y-9-7
@FLOW 3Y-10-7
@FLOW 4Y-7
@FLOW 5Y-8
@FLOW 11Y-10
@BOX 1.0
PROC END.I.REC
@BOX 2.0
DIRECT ACCESS
@BOX 3.0
UNFORMATTED
@BOX 4.0
LIST DIRECTED?
@BOX 5.0
END OF REC CHAR READ
@BOX 6.0
READ REST OF RECORD
@BOX 7.0
END
@BOX 8.0
SELECT NEXT RECORD
@BOX 9.0
SET NEXT RECORD NO
SELECT NEXT RECORD
@BOX 10.0
SELECT.NEXT.RECORD
@BOX 11.0
INTERNAL FILE
@BOX 1.1
;PROC FIO.END.I.REC
@BOX 2.1
;IF STATUS OF CUR.UNIT^ & 2 /= 0
@BOX 3.1
;IF CUR.FMT = -1
@BOX 4.1
;IF CUR.FMT = -2
@BOX 5.1
;IF T.POS >= EOR.POS
@BOX 6.1
;WHILE CONTROL.CHAR[INCH()] = 0 DO OD
@BOX 7.1
;END
@BOX 8.1
;SET.I.POS(EOR.POS + 1)
@BOX 9.1
;SET.I.POS(1 +> RECORD.NO OF CUR.UNIT^ * REC)
@BOX 10.1
;IN.REC()
@BOX 11.1
;IF CUR.UNIT = NIL
@END
@TITLE FTN23.11(1,11)
@COL 1S-2R-3R-4R-5T-6T-7R-8R-9R-10R-11F
@COL 17T-22R-12R-21R-23C
@COL 13T-14R-15T-16R
@ROW 12-10
@ROW 15-17
@ROW 6-13
@FLOW 1-2-3-4-5N-6Y-7-8-9-10-11
@FLOW 5Y-13N-14-15Y-17Y-9
@FLOW 6N-12-21
@FLOW 13Y-16-21
@FLOW 15N-16-21-23
@FLOW 17N-22-21
@BOX 1.0
READ.INT(I.BUF.PTR,WIDTH,SIGN)INT
@BOX 2.0
SET VALUE-ZERO
@BOX 3.0
FOR WIDTH TIMES
@BOX 4.0
SET CHAR FROM
IBUF
@BOX 5.0
IS CHAR SIGN?
@BOX 6.0
DIGIT?
@BOX 7.0
NOTE DIGIT
READ
@BOX 8.0
VALUE*10+DIGIT
=> VALUE
@BOX 9.0
REPEAT
@BOX 10.0
SET SIGN OF
VALUE
@BOX 11.0
END
@BOX 12.0
FAULT
'ILLEGAL CHARACTER
IN INTEGER'
@BOX 13.0
SIGN NOT ALLOWED?
@BOX 14.0
SET SIGN
INHIBIT ADDITIONAL
SIGNS
@BOX 15.0
DIGIT NOT
READ?
@BOX 21.0
ENTER TRAP
@BOX 17.0
NOT END OF
INTEGER
@BOX 16.0
FAULT
'UNEXPECTED
SIGN'
@BOX 22.0
FAULT
'SIGN BUT NO DIGITS'
@BOX 23.0
END
@BOX 1.1
;PROC FIO.READ.INT(IBUF.PTR,WIDTH,INHIBIT.SIGN)
;$IN32 VALUE
;INTEGER NEG.SIGN,DIGIT,CHAR,F
@BOX 2.1
;0 => VALUE => DIGIT => NEG.SIGN
;I.BUF.PTR +> WIDTH
@BOX 3.1
;WHILE I.BUF.PTR /= WIDTH DO
@BOX 4.1
IBUF[I.BUF.PTR] => CHAR
@BOX 5.1
;IF CHAR = '+ OR CHAR = '-
@BOX 6.1
;IF CHAR < '0 OR CHAR > '9
@BOX 7.1
;1 => DIGIT
@BOX 8.1
;VALUE * 10 + '0 - CHAR => VALUE ::CV
@BOX 9.1
;1 +> I.BUF.PTR
OD
@BOX 10.1
;IF NEG.SIGN /= '- THEN 0 -:> VALUE FI ::CV
@BOX 11.1
;VALUE => FIO.READ.INT
END
@BOX 12.1
106 => F
@BOX 21.1
;ENTER.TRAP(6,F)
@BOX 17.1
;IF 1 + IBUFPTR < WIDTH
@BOX 22.1
;120 => F
@BOX 23.1
EXIT
@BOX 13.1
;IF INHIBIT.SIGN = 1
@BOX 14.1
;CHAR => NEG.SIGN
;1 => INHIBIT.SIGN
@BOX 15.1
;IF DIGIT = 0
@BOX 16.1
;115 => F
@END

@TITLE FTN23.12(1,11)
@COL 1S-2T-5R-7R-8F
@COL 4R
@ROW 4-5
@FLO 1-2NO-5-7-8
@FLO 2YES-4-7
@BOX 1.0
FIO.READ.HOLL(I.BUF.PTR,WIDTH,STORAGE)
@BOX 2.0
IS STORAGE GREATER
THAN WIDTH
@BOX 4.0
READ IN CHARACTERS
PAD BALANCE OF STORE WITH
BLANKS
@BOX 5.0
READ IN STORAGE NO.
OF CHARACTERS
@BOX 7.0
NOW CHECK SIZE OF
ITEM AND ASSIGN THE
CORRECT VARIABLE(I64,
I32,I16,I8) TO
FIO.READ.HOLL
@BOX 8.0
END
@BOX 1.1
;PROC FIO.READ.HOLL(I.BUF.PTR,WIDTH,STORE)
;$IN I
@BOX 2.1
;IF STORE > WIDTH
@BOX 4.1
;FOR I < WIDTH DO
    IBUF[I] => HOLL.ARRAY[I] OD
;FOR I < (STORE - WIDTH) DO
    SPACE.L => HOLL.ARRAY[I + WIDTH] OD
@BOX 5.1
;FOR I < STORE DO
     IBUF[I] => HOLL.ARRAY[I]
     OD
@BOX 7.1
;IF STORE = I64.SIZE.L THEN
    I64 => FIO.READ.HOLL
 ELSE
    IF STORE = I32.SIZE.L THEN
       I32 => FIO.READ.HOLL
    ELSE
       IF STORE = I16.SIZE.L THEN
          I16 => FIO.READ.HOLL
       ELSE
          I8 => FIO.READ.HOLL FI FI FI
@BOX 8.1
;END
@END
@TITLE FTN23.13(1,11)
@COL 1S-2T-22R-3R-5R-6T-7R-8T-9T-10R-11R-12R-4R-13F
@COL 15R-16C-14R-17T-18T-19R-20T-21N
@ROW 4-15
@ROW 9-14
@ROW 20-13
@FLOW 1-2N-22-3-5-6N-7-8N-9N-10-11-12-4-13
@FLOW 2Y-15-16
@FLOW 6Y-17N-18N-19-11
@FLOW 8Y-14-17YES-20YES-11
@FLOW 9Y-17N-18Y-20N-21-12
@BOX 1.0
GET FORMATTED.CONST(I.BUF.PTR,BL.EDIT,EXP.WIDTH)ACT.WIDTH
@BOX 2.0
END OF RECORD?
@BOX 3.0
SET LEADING
SPACE FLAG
@BOX 4.0
UPDATE CURRENT AND
TIDEMARK POSITIONS
@BOX 5.0
FOR EXP.WIDTH TIMES
@BOX 6.0
AT END OF RECORD
@BOX 7.0
READ CHAR
@BOX 8.0
END OF REC CHAR
@BOX 9.0
SPACE?
@BOX 10.0
CLEAR LEADING
SPACE FLAG
@BOX 11.0
STORE CHAR
IN IBUF
@BOX 12.0
REPEAT
@BOX 13.0
END
@BOX 14.0
NOTE END OF REC POSITION
@BOX 15.0
FAULT
'END OF RECORD'
@BOX 16.0
END
@BOX 17.0
LEADING SPACE?
@BOX 18.0
NO BLANK EDITING?
@BOX 19.0
SET CHAR = 0
@BOX 20.0
SET CHAR = BLANK
SPACE SIGNIFICANT?
@BOX 22.0
SELECT RECORD POSITION
@BOX 1.1
;PROC FIO.GET.FORM.CONST(IBUFPTR,BL.EDIT,WIDTH)
;INTEGER INIT.IBUF.PTR,I
;IBUF.PTR => INIT.I.BUF.PTR
;INTEGER CHAR,LEADING.SPACE.FLAG
@BOX 2.1
;IF WIDTH + C.POS > E.POS
@BOX 3.1
;1 => LEADING.SPACE.FLAG
@BOX 4.1
;IF I +> C.POS > T.POS THEN
   ;IF C.POS < EOR.POS THEN
      ;C.POS => T.POS
   ;ELSE
      ;EOR.POS => T.POS
   ;FI
;FI
@BOX 5.1
;FOR I < WIDTH DO
@BOX 6.1
;IF C.POS+I >= EOR.POS
@BOX 7.1
;INCH() => CHAR
@BOX 8.1
;IF CONTROL.CHAR[CHAR] /= 0
@BOX 9.1
;IF CHAR = SPACE.L
@BOX 10.1
; 0 => LEADING.SPACE.FLAG
@BOX 11.1
;CHAR => IBUF[I.BUF.PTR]
;1 +> I.BUF.PTR
@BOX 12.1
OD
@BOX 13.1
;IBUFPTR - INITIBUFPTR => FIO.GET.FORM.CONST
END
@BOX 15.1
;ENTER.TRAP(6,110)
@BOX 16.1
EXIT
@BOX 14.1
;C.POS+I => EOR.POS
@BOX 17.1
;IF LEADING.SPACE.FLAG = 1
@BOX 18.1
;IF BL.EDIT & 1 = 1
@BOX 19.1
;'0 => CHAR
@BOX 20.1
; SPACE.L => CHAR
;IF BL.EDIT & 2 /= 0
@BOX 22.1
;WHILE 1+>T.POS < C.POS AND T.POS < EOR.POS DO
   ;IF CONTROL.CHAR[INCH()] /=0 THEN
      ;T.POS => EOR.POS
   ;FI
;OD
@END
@TITLE FTN23.14(1,11)
@COL 1S-2R-3C-4R-5R-6C-7T-8R-9C-15C-20C-30R-31C-32R-33F
@COL 10C-11T-12C-14C-17R-35N-25C-26T-27R-28T-29C
@COL 16C-21T-22C-23R-24C
@ROW 10-6
@ROW 14-15-16
@ROW 26-20
@ROW 30-27
@FLOW 1-2-3-4-5
@FLOW 6-7N-8-9
@FLOW 7Y-4
@FLOW 10-11N-12
@FLOW 11YES-4
@FLOW 15-20
@FLOW 14-17-20
@FLOW 16-21N-22-23-24
@FLOW 21Y-35-20
@FLOW 25-26N-27-28N-29
@FLOW 26Y-30-31
@FLOW 28Y-32-33
@BOX 1.0
GET.LD.CONST(IBUFPTR,TYPE)WIDTH
@BOX 2.0
SET WIDTH = 0
@BOX 3.0
NEXT
CHAR
@BOX 4.0
READ CHAR
@BOX 5.0
SWITCH ON CHAR
TYPE
@BOX 6.0
SPACE
@BOX 7.0
REP CNT = 0 AND
WIDTH = 0?
@BOX 8.0
READ
SEPARATOR:3.16
@BOX 9.0
END
@BOX 10.0
END OF RECORD
@BOX 11.0
REP CNT = 0 AND
WIDTH = 0?
@BOX 12.0
END
@BOX 14.0
/
@BOX 17.0
SET SLASH
@BOX 15.0

@BOX 20.0
END
@BOX 16.0
)
@BOX 21.0
READING
COMPLEX?
@BOX 22.0
OTHERS
@BOX 23.0
STORE CHAR IN
IBUF
INCR WIDTH
@BOX 24.0
NEXT
CHAR
@BOX 25.0
*
@BOX 26.0
RC ALREADY
SET?
@BOX 27.0
RESET IBUFPTR
RESET WIDTH
READ RC FROM
IBUF:3.11
@BOX 28.0
RC =< 0
@BOX 29.0
NEXT
CHAR
@BOX 30.0
FAULT
'ILLEGAL USE OF
REPEAT COUNT'
@BOX 31.0
END
@BOX 32.0
FAULT
'REPEAT COUNT
MUST BE NON-ZERO'
@BOX 33.0
END
@BOX 1.1
;PROC FIO.GET.LD.CONST(IBUFPTR,C.TYPE)
;INTEGER INIT.I.BUF.PTR
;INTEGER WIDTH,CHAR
;DATAVEC LD.CHAR.TYPE($LO8)
 6[4]  1  6[5]  1  6  1  6[3]
 6[16]
 0 6[6] 6 6 4 5 6 2 6 6 3
 6[80]
 END
;I.BUF.PTR => INIT.I.BUF.PTR
@BOX 2.1
;0 => WIDTH
@BOX 3.1
;NEXT.CHAR:
@BOX 4.1
;INCH() => CHAR
@BOX 5.1
;SWITCH LD.CHAR.TYPE[CHAR] \
    SPACES,
    CONTROL,
    ANON,
    SLASHS,
    RIGHT,
    ASTERISK,
    OTHERS
@BOX 6.1
;SPACES:
@BOX 10.1
;CONTROL:
@BOX 15.1
;ANON:
@BOX 14.1
;SLASHS:
@BOX 16.1
;RIGHT:
@BOX 25.1
;ASTERISK:
@BOX 22.1
;OTHERS:
@BOX 7.1
;IF WIDTH = 0 AND LD.REP.CNT=0
@BOX 8.1
;FIO.READ.SEPARATOR(CHAR)
@BOX 9.1
;WIDTH => FIO.GET.LD.CONST
EXIT
@BOX 11.1
;IF WIDTH = 0 AND LD.REP.CNT = 0
@BOX 12.1
;WIDTH => FIO.GET.LD.CONST
EXIT
@BOX 20.1
;WIDTH => FIO.GET.LD.CONST
EXIT
@BOX 30.1
;ENTER.TRAP(6,108)
@BOX 31.1
EXIT
@BOX 32.1
;ENTER.TRAP(6,109)
@BOX 33.1
END
@BOX 17.1
;1 => SLASH
@BOX 26.1
;IF LD.REP.CNT /= 0
@BOX 29.1
;-> NEXT.CHAR
@BOX 21.1
;IF C.TYPE = 1
@BOX 23.1
;CHAR => IBUF[I.BUF.PTR]
; 1 +> WIDTH
; 1 +> I.BUF.PTR
@BOX 24.1
;-> NEXT.CHAR
@BOX 27.1
;FIO.READ.INT(INIT.I.BUF.PTR => I.BUF.PTR, WIDTH, 1)-1 => LD.REP.CNT
;0 => WIDTH
@BOX 28.1
;IF LD.REP.CNT < 0
@END
@TITLE FTN23.15(1,6)
@COL 1S-2R-3T-4R-5C-6T-7R-8C-9R-10C-11T-12R-13T-14R
@COL 22T-23T-24R-25C-15R-16R-17T-18R-20C-21F
@ROW 4-22
@ROW 7-16
@ROW 10-17
@FLOW 1-2-3N-4-5-6N-7-8-9-10-11N-12-13N-14-17N-18-20-21
@FLOW 6Y-16-9
@FLOW 11Y-13Y-17Y-20
@FLOW 3Y-22N-23N-24-25
@FLOW 22Y-15-21
@FLOW 23Y-9
@BOX 1.0
READ REAL(I.BUF.PTR,WIDTH,FRAC.WIDTH)REAL
@BOX 2.0
FOR EACH CHAR
@BOX 3.0
NOT DIGIT?
@BOX 4.0
NOTE DIGIT
READ
@BOX 5.0
ACC
CHAR
@BOX 6.0
FRAC?
@BOX 7.0
ACC NO
@BOX 8.0
NEXT
CHAR
@BOX 9.0
REPEAT
@BOX 10.0
END
NO
@BOX 11.0
POSITIVE?
@BOX 12.0
NEGATE
@BOX 13.0
ZERO FRAC WIDTH OR
DECIMAL POINT?
@BOX 14.0
ADJUST FOR D
@BOX 15.0
CHECK CHAR:3.15.1
@BOX 16.0
ACC.FRAC
@BOX 17.0
ZERO SCALE OR
EXPON?
@BOX 18.0
SCALE?
@BOX 19.0
STORE REAL
@BOX 20.0
OUT
@BOX 21.0
END
@BOX 22.0
DIGIT READ
OR DOT
@BOX 23.0
VALID SIGN
@BOX 24.0
FAULT
'INVALID CHAR'
@BOX 25.0
END
@BOX 1.1
;PROC FIO.READ.REAL(I.BUF.PTR,WIDTH,FRAC.WIDTH)
;INTEGER DP,EXPON,SIGN,DIGIT,CHAR,F
;$RE32 X,TENS
;RD0.0 => X
;RD1.0 => TENS
;0 => DP => EXPON => SIGN => DIGIT
@BOX 2.1
;WHILE 1 -> WIDTH >=0 DO
;   IBUF[IBUF.PTR] => CHAR
;    1 +> IBUF.PTR
@BOX 3.1
;   IF CHAR < '0 OR CHAR >'9
@BOX 4.1
;    1 => DIGIT
@BOX 5.1
;    ACC.CHAR:
@BOX 6.1
;    IF DP /= 0
@BOX 7.1
;    RD10.0 *> X
;    (CHAR-'0) +> X
@BOX 8.1
; NEXT.CHAR:
@BOX 9.1
OD
@BOX 10.1
;END.NO:
@BOX 11.1
;IF SIGN /= '-
@BOX 12.1
;RD0.0 -:> X
@BOX 13.1
;IF DP /=0 OR FRAC.WIDTH = 0
@BOX 14.1
;EXP((0-FRAC.WIDTH)*RD.LOG10.0)*>X
@BOX 15.1
#FTN23.15.1
@BOX 16.1
;RD10.0 /> TENS
;(CHAR-'0) * TENS +>X
@BOX 17.1
;IF EXPON /=0 OR SCF = 0
@BOX 18.1
;EXP(SCF*RDLOG0.1)*>X
@BOX 20.1
;OUT:
@BOX 21.1
;X => FIO.READ.REAL
END
@BOX 22.1
;IF DIGIT = 1 OR CHAR = '.
@BOX 23.1
;0 => F
;IF SIGN = 0 THEN
   IF CHAR => SIGN /= '+ AND CHAR /= '- THEN
      1 => F
   FI
ELSE
   1 => F
FI
;IF F = 0
@BOX 24.1
;ENTER.TRAP(6,114)
@BOX 25.1
EXIT
@END
@TITLE FTN23.15.1(1,6)
@COL 1S-2T-3T-4R-5C
@COL 6T-8R-9R-10C-11R-12C
@ROW 3-6
@FLOW 1-2N-3N-4-5
@FLOW 2Y-6N-8-9-10
@FLOW 6Y-11-12
@FLOW 3Y-11
@BOX 1.0
CHECK CHAR
@BOX 2.0
NOT D.POINT?
@BOX 3.0
NOT FIRST DP?
@BOX 4.0
SET DP
@BOX 5.0
NEXT
CHAR
@BOX 6.0
 NOT
 E OR D
@BOX 8.0
READ IN EXP
@BOX 9.0
ACC NO
@BOX 10.0
END.NO
@BOX 11.0
FAULT
'STRANGE CHAR'
@BOX 12.0
OUT
@BOX 1.1
@BOX 2.1
;IF CHAR /= '.
@BOX 3.1
;IF DP /= 0
@BOX 4.1
;1 => DP
@BOX 5.1
; -> NEXT.CHAR
@BOX 6.1
;IF CHAR /= 'E AND CHAR /= 'D
@BOX 8.1
;FIO.READ.INT(I.BUF.PTR,WIDTH,0) => EXP.ON
@BOX 9.1
;EXP(EXP.ON * RDLOG10.0) *> X
;1 => EXP.ON
@BOX 10.1
;->END.NO
@BOX 11.1
;ENTER.TRAP(6,114)
@BOX 12.1
;-> OUT
@END
@TITLE FTN23.16(1,11)
@COL 9R-11N
@COL 1S-2R-3T-4T-5T-10T-6R-8F
@COL 7R
@ROW 9-6
@ROW 6-7
@FLOW 1-3N-4N-5N-10N-6-8
@FLOW 3Y-2-3
@FLOW 4Y-8
@FLOW 5Y-7-8
@FLOW 10Y-9-8
@BOX 1.0
READ SEPARATOR(CHAR)
@BOX 2.0
READ CHAR
FROM I.STR
@BOX 3.0
SPACE?
@BOX 4.0
END OF RECORD CHARACTER
OR ,
@BOX 5.0
Slash?
@BOX 6.0
INBACKSPACE(1)
@BOX 8.0
END
@BOX 9.0
FAULT
'ILLEGAL
VALUE SEPARATOR'
@BOX 10.0
NO CHARS READ
@BOX 7.0
SET
SLASH
@BOX 1.1
;PROC FIO.READ.SEPARATOR(CHAR)
;INTEGER F
; 0 => F
@BOX 2.1
;INCH() => CHAR
; 1 => F
@BOX 3.1
;IF CHAR = SPACE.L
@BOX 4.1
;IF CHAR = ', OR CONTROLCHAR[CHAR] = 1
@BOX 5.1
;IF CHAR = '/
@BOX 6.1
;INBACKSPACE(1)
@BOX 7.1
; 1 => SLASH
@BOX 8.1
END
@BOX 9.1
;ENTER.TRAP(6,107)
@BOX 10.1
;IF F = 0
@END
@TITLE FTN23.17(1,6)
@COL 1S-2T-3T-4T-5R-6T-7T-8R-9F
@COL 16N-15N-10R
@COL 17N-11R-12C
@ROW 8-10-11
@ROW 7-15-17
@ROW 16-4
@FLOW 1-2N-3N-4N-5-6N-7N-8-9
@FLOW 2Y-17-11
@FLOW 3Y-6Y-10-9
@FLOW 4Y-16-17-11-12
@FLOW 7Y-15-11-12
@BOX 1.0
READ.LOGICAL(WIDTH)L
@BOX 2.0
WIDTH = 0
@BOX 3.0
FIRST CHAR /=.
@BOX 4.0
WIDTH = 1
@BOX 5.0
GET SECOND
CHAR
@BOX 6.0
CHAR = 'T'?
@BOX 7.0
CHAR /= 'F'?
@BOX 8.0
SET RESULT
= FALSE
@BOX 9.0
END
@BOX 10.0
SET RESULT
= TRUE
@BOX 11.0
FAULT
'ILLEGAL LOGICAL
CONSTANT'
@BOX 12.0
END
@BOX 1.1
;PROC FIO.READ.LOGICAL(WIDTH)
;INTEGER CHAR,I.BUF.PTR
;LOGICAL L
;0 => I.BUF.PTR
@BOX 2.1
;IF WIDTH = 0
@BOX 3.1
;IF IBUF[I.BUF.PTR] => CHAR /= '.
@BOX 4.1
;IF WIDTH = 1
@BOX 5.1
;1 +> I.BUF.PTR
;IBUF[I.BUF.PTR] => CHAR
@BOX 6.1
;IF CHAR = 'T
@BOX 7.1
;IF CHAR /= 'F
@BOX 8.1
;0 => L
@BOX 9.1
;L => FIO.READ.LOGICAL
END
@BOX 10.1
;1 => L
@BOX 11.1
;ENTER.TRAP(6,111)
@BOX 12.1
EXIT
@END
@TITLE FTN23.18(1,6)
@COL 1S-2R-3R-4T-5R-6R-7R-8F
@COL 9R
@ROW 5-9
@FLOW 1-2-3-4N-5-6-7-8
@FLOW 4Y-9-6
@BOX 1.0
READ STRING(IBUF.WIDTH, S LIST.ITEM)
@BOX 2.0
GET WIDTH OF
LIST ITEM
@BOX 3.0
FOR LIST-ITEM-WIDTH
TIMES
@BOX 4.0
NO MORE CHARS
IN IBUF?
@BOX 5.0
GET NEXT CHAR
FROM IBUF
@BOX 6.0
STORE IN
LIST ITEM
@BOX 7.0
REPEAT
@BOX 8.0
END
@BOX 9.0
CHAR = BLANK
@BOX 1.1
;PROC FIO.READ.STRING(I.BUF.WIDTH,LIST.ITEM)
;INTEGER WIDTH,I,CHAR,I.BUF.P
@BOX 2.1
;SIZE(LIST.ITEM) => WIDTH
@BOX 3.1
; IF IBUF.WIDTH > WIDTH THEN I.BUF.WIDTH-WIDTH=> I.BUF.P
   ELSE 0 => I.BUF.P FI
;FOR I < WIDTH DO
@BOX 4.1
;IF I.BUF.WIDTH = I.BUF.P
@BOX 5.1
;IBUF[1 +> I.BUF.P] => CHAR
@BOX 6.1
;CHAR => LIST.ITEM^[I]
@BOX 7.1
OD
@BOX 8.1
END
@BOX 9.1
;SPACE.L => CHAR
@END
@TITLE FTN23.19(1,11)
@COL 1S-2T-3R-4T-5T-6R-8F
@COL 9R-11R-13R-14R-12C
@ROW 3-9
@FLOW 1-2N-3-4N-5N-6-8
@FLOW 2Y-9-14
@FLOW 4Y-11-14
@FLOW 5Y-13-14
@BOX 1.0
READ.REPEAT.COUNT(CUR.CHAR)CUR.CHAR
@BOX 2.0
CHAR NOT
A DIGIT?
@BOX 3.0
READ
REPEAT COUNT
@BOX 4.0
RC = ZERO?
@BOX 5.0
NOT FOLLOWED BY
*?
@BOX 6.0
READ CHAR
@BOX 8.0
END
@BOX 9.0
FAULT
'ILLEGAL CHAR'
@BOX 11.0
FAULT
'ZERO REPEAT COUNT'
@BOX 12.0
END
@BOX 13.0
FAULT
'* MISSING
AFTER REPEAT'
COUNT
@BOX 14.0
ENTER TRAP
@BOX 1.1
;PROC FIO.READ.REPEAT.COUNT(CHAR)
;INTEGER INT,F
@BOX 2.1
;IF CHAR < '0 OR CHAR > '9
@BOX 3.1
; 0 => INT
;WHILE CHAR > '0 AND CHAR < '9 DO
   INT *10 + CHAR - 10 => INT
  ;INCH() => CHAR
 OD
@BOX 4.1
;IF INT -1 => LD.REP.CNT < 0
@BOX 5.1
;IF CHAR /= '*
@BOX 6.1
;INCH() => CHAR
@BOX 9.1
;112 => F
@BOX 11.1
;109 => F
@BOX 12.1
EXIT
@BOX 13.1
;113 => F
@BOX 14.1
;ENTER.TRAP(6,F)
@BOX 8.1
CHAR => FIO.READ.REPEAT.COUNT
END
@END
@TITLE FTN23.20(1,11)
@COL 1S-2T-3T-5R-6T-7R-8R-9F
@COL 10R-11R
@ROW 3-10
@FLOW 1-2N-3N-5-6N-7-8-9
@FLOW 2Y-10-11-6
@FLOW 3Y-9
@FLOW 6Y-9
@BOX 1.0
LD.I32.READ(S.INT)
@BOX 2.0
RC > 0
@BOX 3.0
SLASH?
@BOX 5.0
GET LIST.DIR
CONSTANT:3.14
@BOX 6.0
NULL?
@BOX 7.0
READ.INT:3.11
@BOX 8.0
ASSIGN INT VALUE
@BOX 9.0
END
@BOX 10.0
SET WIDTH OF
CONSTANT
@BOX 11.0
DECR REPEAT
COUNT
@BOX 1.1
;PROC FIO.LD.I32.READ(INT)
@BOX 2.1
;IF LD.REP.CNT > 0
@BOX 3.1
;IF SLASH = 1
@BOX 5.1
;FIO.GET.LD.CONST(0,0) => ACT.WIDTH.1
@BOX 6.1
;IF ACT.WIDTH1 = 0
@BOX 7.1
;FIO.READ.INT(0,ACT.WIDTH.1,0) => INT^
@BOX 8.1
:: IN BOX 7
@BOX 10.1
:: NO CODE REQUIRED
@BOX 11.1
; 1 -> LD.REP.CNT
@BOX 9.1
END
@END
@TITLE FTN23.20.1(1,11)
@COL 1S-7R-8R-9F
@FLOW 1-7-8-9
@BOX 1.0
LD.I16.READ(S.INT)
@BOX 7.0
READ.INT:3.20
@BOX 8.0
ASSIGN INT VALUE
@BOX 9.0
END
@BOX 1.1
;PROC FIO.LD.I16.READ(INT)
;$IN32 I32
@BOX 7.1
;INT^ => I32
;FIO.LD.I32.READ(^I32)
@BOX 8.1
;I32 => INT^
@BOX 9.1
END
@END
@TITLE FTN23.20.2(1,11)
@COL 1S-7R-8R-9F
@FLOW 1-7-8-9
@BOX 1.0
LD.I8.READ(S.INT)
@BOX 7.0
READ.INT:3.20
@BOX 8.0
ASSIGN INT VALUE
@BOX 9.0
END
@BOX 1.1
;PROC FIO.LD.I8.READ(INT)
;$IN32 I32
@BOX 7.1
;INT^ => I32
;FIO.LD.I32.READ(^I32)
@BOX 8.1
;I32 => INT^
@BOX 9.1
END
@END
@TITLE FTN23.21(1,6)
@COL 1S-2T-3T-5R-6T-7R-8R-9F
@COL 10R-11R
@ROW 3-10
@FLOW 1-2N-3N-5-6N-7-8-9
@FLOW 2Y-10-11-6
@FLOW 3Y-9
@FLOW 6Y-9
@BOX 1.0
LD.R.READ(S REAL)
@BOX 2.0
RC > 0?
@BOX 3.0
SLASH?
@BOX 5.0
GET LIST
DIR CONSTANT
:3.14
@BOX 6.0
NULL?
@BOX 7.0
READ REAL
:3.15
@BOX 8.0
ASSIGN
REAL VALUE
@BOX 9.0
END
@BOX 10.0
SET WIDTH
OF CONSTANT
@BOX 11.0
DECREMENT
REPEAT COUNT
@BOX 1.1
;PROC FIO.LD.R.READ(REAL.X)
@BOX 2.1
;IF LD.REP.CNT > 0
@BOX 3.1
;IF SLASH = 1
@BOX 5.1
;FIO.GET.LD.CONST(0,0) => ACT.WIDTH.1
@BOX 6.1
;IF ACT.WIDTH1 = 0
@BOX 7.1
;FIO.READ.REAL(0,ACT.WIDTH.1,0) => REAL.X^
@BOX 8.1
:: IN BOX 7
@BOX 9.1
END
@BOX 10.1
:: NO CODE REQUIRED
@BOX 11.1
;1 -> LD.REP.CNT
@END
@TITLE FTN23.22(1,6)
@COL 1S-2T-3T-5R-6T-7R-8R-9F
@COL 10R-11R
@ROW 3-10
@FLOW 1-2N-3N-5-6N-7-8-9
@FLOW 2Y-10-11-6
@FLOW 3Y-9
@FLOW 6Y-9
@BOX 1.0
LD.DP.READ(S DP)
@BOX 2.0
RC > 0?
@BOX 3.0
SLASH?
@BOX 5.0
GET LIST
DIR.CONSTANT
:3.14
@BOX 6.0
NULL?
@BOX 7.0
READ DP.REAL
:3.15
@BOX 8.0
ASSIGN
REAL VALUE
@BOX 9.0
END
@BOX 10.0
SET WIDTH
OF CONSTANT
@BOX 11.0
DECREMENT
REPEAT COUNT
@BOX 1.1
;PROC FIO.LD.DP.READ(DP)
@BOX 2.1
;IF LD.REP.CNT > 0
@BOX 3.1
;IF SLASH = 1
@BOX 5.1
;FIO.GET.LD.CONST(0,0) => ACT.WIDTH.1
@BOX 6.1
;IF ACT.WIDTH.1 = 0
@BOX 7.1
;FIO.READ.DP(ACT.WIDTH.1,0) => DP^
@BOX 8.1
::IN BOX 7
@BOX 10.1
::NO CODE REQUIRED
@BOX 11.1
;1 -> LD.REP.CNT
@BOX 9.1
END
@END
@TITLE FTN23.23(1,11)
@COL 34C
@COL 1S-2T-3T-4R-5T-6T-8R-9R-10R-11T-12T-13R-14R-15R-16T-17T-18R-19T-20R-21R-22F
@COL 26R-42T-43T-36R-37R-38C-44R-45C-27T-28T-29R-35C-30R-31T-32R-33C-25R-40C
@ROW 34-4-26
@ROW 21-25
@FLOW 1-2N-3N-4-5N-6N-8-9-10-11N-12N-13-14-15-16N-17N-18-19N-20-21-22
@FLOW 2Y-26-42N-43N-36-37-38
@FLOW 3Y-34
@FLOW 5Y-4-5N-6Y-27N-28N-29N-35
@FLOW 11Y-10-11N-12Y-44
@FLOW 16Y-15-16N-17Y-44
@FLOW 19Y-25-40
@FLOW 27Y-35
@FLOW 28Y-30-31N-32-33
@FLOW 31Y-8
@FLOW 42Y-38
@FLOW 43Y-44-45
@BOX 1.0
LD.C.READ(S COMPLEX)
@BOX 2.0
RC > 0?
@BOX 3.0
SLASH?
@BOX 4.0
READ CHAR
@BOX 5.0
EOR OR SPACE?
@BOX 6.0
NOT '('?
@BOX 8.0
PUT '(' IN IBUF
GET LIST.DIR.CONST:3.14
SAVE POSITION AND
WIDTH OF REAL PART
@BOX 9.0
INBACKSPACE(1)
@BOX 10.0
READ CHAR
@BOX 11.0
EOR OR SPACE?
@BOX 12.0
NOT ,?
@BOX 13.0
GET LIST.DIR.CONST:3.14
SAVE POSITION AND
WIDTH OF IMAG PART
@BOX 14.0
INBACKSPACE(1)
@BOX 15.0
READ CHAR
@BOX 16.0
EOR OR SPACE?
@BOX 17.0
NOT ')'?
@BOX 18.0
READ SEPARATOR:3.16
@BOX 19.0
NULL VALUE FOR REAL
OR IMAG.PART?
@BOX 20.0
READ REAL PART
FROM IBUF:3.15
@BOX 21.0
READ IMAG.PART
FROM IBUF:3.15
@BOX 22.0
END
@BOX 34.0
END
@BOX 25.0
FAULT
ILLEGAL USE
OF NULL VALUE
@BOX 26.0
DECR REP CNT
SET POSITION AND
WIDTH OF REAL
AND IMAG.PARTS
@BOX 27.0
','
@BOX 28.0
NOT /?
@BOX 29.0
SET SLASH
@BOX 30.0
READ REPEAT
COUNT:3.19
@BOX 31.0
IS NEXT CHAR
'('?
@BOX 32.0
SET WIDTH =0 FOR
REPEAT COUNT OF NULLS
READ SEPARATOR
@BOX 40.0
END
@BOX 33.0
END
@BOX 35.0
END
@BOX 36.0
READ REAL PART
FROM IBUF:3.15
@BOX 37.0
READ IMAG. PART
FROM IBUF:3.15
@BOX 38.0
END
@BOX 42.0
NULL
@BOX 43.0
ITEM IN IBUF COMPLEX ?
@BOX 44.0
FAULT 'ILLEGAL CHAR'
@BOX 45.0
END
@BOX 1.1
;PROC FIO.LD.C.READ(COMPL)
;$IN CHAR
;COMPLEX RES
@BOX 2.1
;IF LD.REP.CNT > 0
@BOX 3.1
;IF SLASH = 1
@BOX 4.1
;INCH() => CHAR
@BOX 5.1
;IF CHAR = SPACE.L OR CONTROLCHAR[CHAR] = 1
@BOX 6.1
;IF CHAR /= '(
@BOX 8.1
;'( => IBUF[0]
;FIO.GET.LD.CONST(1,0) => ACT.WIDTH.1
@BOX 9.1
;INBACKSPACE(1)
@BOX 10.1
;INCH() => CHAR
@BOX 11.1
;IF CHAR = SPACE.L OR CONTROLCHAR[CHAR] = 1
@BOX 12.1
;IF CHAR /= ',
@BOX 13.1
;FIO.GET.LD.CONST(ACT.WIDTH.1+1,1) => ACT.WIDTH.2
@BOX 14.1
;INBACKSPACE(1)
@BOX 15.1
;INCH() => CHAR
@BOX 16.1
;IF CHAR = SPACE.L OR CONTROLCHAR[CHAR] = 1
@BOX 17.1
;IF CHAR /= ')
@BOX 18.1
;FIO.READ.SEPARATOR(INCH())
@BOX 19.1
;IF ACT.WIDTH.1 = 0 OR ACT.WIDTH.2 = 0
@BOX 20.1
;FIO.READ.REAL(1,ACT.WIDTH.1,0) => R OF RES
@BOX 21.1
;FIO.READ.REAL(ACT.WIDTH.1+1,ACT.WIDTH.2,0) => I OF RES
@BOX 34.1
EXIT
@BOX 40.1
EXIT
@BOX 25.1
;ENTER.TRAP(6,103)
@BOX 26.1
;1 -> LD.REP.CNT
@BOX 36.1
;FIO.READ.REAL(1,ACT.WIDTH.1,0) => R OF RES
@BOX 37.1
;FIO.READ.REAL(ACT.WIDTH.1+1,ACT.WIDTH.2,0) => I OF RES
@BOX 38.1
;RES => COMPL^
EXIT
@BOX 27.1
;IF CHAR = '/
@BOX 28.1
;IF CHAR /= ',
@BOX 29.1
;1 => SLASH
@BOX 35.1
EXIT
@BOX 30.1
;FIO.READ.REPEAT.COUNT(CHAR) => CHAR
@BOX 31.1
;IF CHAR = '(
@BOX 32.1
;0 => ACT.WIDTH.1 => ACT.WIDTH.2
;FIO.READ.SEPARATOR(CHAR)
@BOX 33.1
EXIT
@BOX 22.1
;RES => COMPL^
END
@BOX 42.1
;IF ACT.WIDTH.1 = 0
@BOX 43.1
;IF IBUF[0] /= '(
@BOX 44.1
;ENTER.TRAP(6,102)
@BOX 45.1
EXIT
@END
@TITLE FTN23.24(1,11)
@COL 1S-2T-3T-5R-6T-7R-8R-9F
@COL 10R-11R
@ROW 3-10
@FLOW 1-2N-3N-5-6N-7-8-9
@FLOW 2Y-10-11-6
@FLOW 3Y-9
@FLOW 6Y-9
@BOX 1.0
LD.L32.READ(S.L)
@BOX 2.0
RC > 0?
@BOX 3.0
SLASH?
@BOX 5.0
GET LIST DIRECTED
CONSTANT:3.14
@BOX 6.0
NULL?
@BOX 7.0
READ LOGICAL
:3.17
@BOX 8.0
ASSIGN LOGICAL
VALUE
@BOX 9.0
END
@BOX 10.0
SET WIDTH OF
CONSTANT
@BOX 11.0
DECREMENT
REPEAT COUNT
@BOX 1.1
;PROC FIO.LD.L32.READ(L)
@BOX 2.1
;IF LD.REP.CNT > 0
@BOX 3.1
;IF SLASH = 1
@BOX 5.1
;FIO.GET.LD.CONST(0,0) => ACT.WIDTH.1
@BOX 6.1
;IF ACT.WIDTH.1 = 0
@BOX 7.1
;FIO.READ.LOGICAL(ACT.WIDTH.1) => L^
@BOX 8.1
:: IN BOX 7
@BOX 9.1
END
@BOX 10.1
:: NO CODE REQUIRED
@BOX 11.1
1 -> LD.REP.CNT
@END
@TITLE FTN23.24.1(1,11)
@COL 1S-7R-8R-9F
@FLOW 1-7-8-9
@BOX 1.0
LD.L16.READ(S.L)
@BOX 7.0
READ LOGICAL
:3.24
@BOX 8.0
ASSIGN LOGICAL
VALUE
@BOX 9.0
END
@BOX 1.1
;PROC FIO.LD.L16.READ(L)
;$LO32 L32
@BOX 7.1
;L^ => L32
;FIO.LD.L32.READ(^L32)
@BOX 8.1
;L32 => L^
@BOX 9.1
END
@END
@TITLE FTN23.24.2(1,11)
@COL 1S-7R-8R-9F
@FLOW 1-7-8-9
@BOX 1.0
LD.L8.READ(S.L)
@BOX 7.0
READ LOGICAL
:3.24
@BOX 8.0
ASSIGN LOGICAL
VALUE
@BOX 9.0
END
@BOX 1.1
;PROC FIO.LD.L8.READ(L)
;$LO32 L32
@BOX 7.1
;L^ => L32
;FIO.LD.L32.READ(^L32)
@BOX 8.1
;L32 => L^
@BOX 9.1
END
@END
@TITLE FTN23.25(1,6)
@COL 1S-2T-3T-4R-5T-6T-37R-7R-8T-33T-9R-10R-11T-12R-16R-17R-18F
@COL 22R-23R-42T-34T-40R-20C-35R-36C-24T-25T-26R-27C-28R-29T-30R-31C
@ROW 2-22
@ROW 8-24
@FLOW 1-2N-3N-4-5N-6N-37-7-8N-33N-9-7-8Y-7
@FLOW 33Y-10-11N-12-16-17-18
@FLOW 2Y-22-23-42N-34N-40-20
@FLOW 3Y-20
@FLOW 5Y-4-5N-6Y-24N-25N-26-27
@FLOW 8Y-7
@FLOW 11Y-9
@FLOW 24Y-27
@FLOW 25Y-28-29N-30-31
@FLOW 29Y-37
@FLOW 42Y-20
@FLOW 34Y-35-36
@BOX 1.0
LD.STR.READ(S CHAR STRING)
@BOX 2.0
RC?
@BOX 3.0
SLASH?
@BOX 4.0
READ CHAR
@BOX 5.0
SPACE OR EOR?
@BOX 6.0
RESET WIDTH
NOT " ?
@BOX 7.0
READ CHAR
@BOX 8.0
EOR?
@BOX 33.0
"?
@BOX 9.0
PUT IN IBUF
@BOX 10.0
READ CHAR
@BOX 11.0
"?
@BOX 12.0
SET WIDTH
@BOX 16.0
READ
SEPARATOR
@BOX 17.0
READ STRING
:3.18
@BOX 18.0
END
@BOX 20.0
END
@BOX 22.0
SET WIDTH OF
CHAR CONSTANT
@BOX 23.0
DECREMENT
REPEAT COUNT
@BOX 24.0
,?
@BOX 25.0
NOT /?
@BOX 26.0
SET SLASH
@BOX 27.0
END
@BOX 28.0
READ REPEAT COUNT
:3.19
@BOX 29.0
NEXT CHAR = "?
@BOX 30.0
SET WIDTH = 0
FOR REPEATED NULLS
READ SEPARATOR
@BOX 31.0
END
@BOX 40.0
READ STRING
:3.18
@BOX 42.0
NULL?
@BOX 37.0
PUT ' IN IBUF
@BOX 34.0
STRING IN IBUF
@BOX 35.0
FAULT
'ILLEGAL CHAR'
@BOX 36.0
END
@BOX 1.1
;PROC FIO.LD.STR.READ(CHAR.STRING)
;INTEGER CHAR,WIDTH
@BOX 2.1
;IF LD.REP.CNT /= 0
@BOX 3.1
;IF SLASH = 1
@BOX 4.1
;INCH() => CHAR
@BOX 5.1
;IF CHAR = SPACE.L OR CONTROLCHAR[CHAR] = 1
@BOX 6.1
;0 => ACT.WIDTH.1
;IF CHAR /= ''
@BOX 7.1
;INCH() => CHAR
@BOX 8.1
;IF CONTROL.CHAR[CHAR] = 1
@BOX 9.1
;CHAR => IBUF[1 +> ACT.WIDTH.1]
@BOX 10.1
;INCH() => CHAR
@BOX 33.1
;IF CHAR = ''
@BOX 11.1
;IF CHAR = ''
@BOX 12.1
:: WIDTH USED AS CNT IN BOX9
@BOX 16.1
;FIO.READ.SEPARATOR (CHAR)
@BOX 17.1
;FIO.READ.STRING(ACT.WIDTH.1,CHAR.STRING)
@BOX 22.1
:: NO CODE REQUIRED
@BOX 23.1
; 1 -> LD.REP.CNT
@BOX 40.1
;FIO.READ.STRING(ACT.WIDTH.1,CHAR.STRING)
@BOX 20.1
EXIT
@BOX 24.1
;IF CHAR = ',
@BOX 25.1
;IF CHAR /= '/
@BOX 26.1
; 1 => SLASH
@BOX 27.1
EXIT
@BOX 28.1
;FIO.READ.REPEAT.COUNT(CHAR) => CHAR
@BOX 29.1
;IF CHAR = ''
@BOX 30.1
; 0 => ACT.WIDTH.1
;FIO.READ.SEPARATOR(CHAR)
@BOX 31.1
EXIT
@BOX 18.1
END
@BOX 42.1
;IF ACT.WIDTH.1 = 0
@BOX 37.1
;'' => IBUF[0]
@BOX 34.1
;IF IBUF[0] /= ''
@BOX 35.1
;SELECT.OUTPUT(0)
;CAP(%" CURRENT INPUT ");OUTHEX(CURRENT.INPUT(),8)
;CAP(%" SILLY CHAR IS ");OUTHEX(CHAR,8);
;CAP(%" IPOS  ");OUTHEX(IPOS(),8);
;NEWLINES(1)
;ENTER.TRAP(6,102)
@BOX 36.1
EXIT
@END
@TITLE FTN23.26(1,11)
@COL 1S-2R-3T-4R-5C-6T-7R-8C-9R-10C-11T-12R-13T-14R
@COL 22T-23T-24R-25C-15R-16R-17T-18R-20C-21F
@ROW 4-22
@ROW 7-16
@ROW 10-17
@FLOW 1-2-3N-4-5-6N-7-8-9-10-11N-12-13N-14-17N-18-20-21
@FLOW 6Y-16-8
@FLOW 11Y-13Y-17Y-20
@FLOW 3Y-22N-23N-24-25
@FLOW 22Y-15-21
@FLOW 23Y-9
@BOX 1.0
READ DP.REAL(WIDTH,FRAC.WIDTH)
@BOX 2.0
FOR EACH CHAR
@BOX 3.0
NOT DIGIT?
@BOX 4.0
NOTE DIGIT
READ
@BOX 5.0
ACC
CHAR
@BOX 6.0
FRAC?
@BOX 7.0
ACC NO
@BOX 8.0
NEXT
CHAR
@BOX 9.0
REPEAT
@BOX 10.0
END
NO
@BOX 11.0
POSITIVE?
@BOX 12.0
NEGATE
@BOX 13.0
DECIMAL POINT?
@BOX 14.0
ADJUST FOR D
@BOX 15.0
CHECK CHAR:3.4.2
@BOX 16.0
ACC.FRAC
@BOX 17.0
SCALE = 0 OR
EXPON?
@BOX 18.0
SCALE?
@BOX 19.0
STORE REAL
@BOX 20.0
OUT
@BOX 21.0
END
@BOX 22.0
DIGIT READ
OR DOT
@BOX 23.0
VALID SIGN
@BOX 24.0
FAULT
'INVALID CHAR'
@BOX 25.0
END
@BOX 1.1
;PROC FIO.READ.DP(WIDTH,FRAC.WIDTH)
;$IN DP,EXPON,SIGN,DIGIT,CHAR,F,IBUFPTR
;$RE64 X,TENS
;RQ0.0 => X
;RQ1.0 => TENS
;0 => DP => EXPON => SIGN => DIGIT => IBUFPTR
@BOX 2.1
;WHILE 1 -> WIDTH >= 0 DO
   IBUF[IBUFPTR] => CHAR
;1 +> IBUFPTR
@BOX 3.1
;IF CHAR < '0 OR CHAR > '9
@BOX 4.1
;1 => DIGIT
@BOX 5.1
;ACC.CHAR:
@BOX 6.1
;IF DP /= 0
@BOX 7.1
;RQ10.0 *> X
;(CHAR - '0) +> X
@BOX 8.1
;NEXT.CHAR:
@BOX 9.1
OD
@BOX 10.1
;END.NO:
@BOX 11.1
;IF SIGN /= '-
@BOX 12.1
;RQ0.0 -:> X
@BOX 13.1
;IF DP /= 0 OR FRAC.WIDTH = 0
@BOX 14.1
;DEXP((0-FRAC.WIDTH) * RQLOG10.0) *> X
@BOX 15.1
#FTN23.26.1
@BOX 16.1
;RQ0.1 *> TENS
;(CHAR - '0) * TENS +> X
@BOX 17.1
;IF EXPON /= 0 OR SCF = 0
@BOX 18.1
;DEXP(SCF * RQLOG0.1) *> X
@BOX 20.1
;OUT:
@BOX 21.1
;X => FIO.READ.DP
END
@BOX 22.1
;IF DIGIT = 1 OR CHAR = '.
@BOX 23.1
;0 => F
;IF SIGN = 0 THEN
   IF CHAR => SIGN /= '+ /= '- THEN
      1 => F
   FI
ELSE
   1 => F
FI
;IF F = 0
@BOX 24.1
;ENTER.TRAP(6,114)
@BOX 25.1
EXIT
@END
@TITLE FTN23.26.1(1,6)
@COL 1S-2T-3T-4R-5C
@COL 6T-8R-9R-10C-11R-12C
@ROW 3-6
@FLOW 1-2N-3N-4-5
@FLOW 2Y-6N-8-9-10
@FLOW 3Y-11-12
@FLOW 6Y-11
@BOX 1.0
CHECK.CHAR
@BOX 2.0
NOT D.POINT?
@BOX 3.0
NOT FIRST DP?
@BOX 4.0
SET DP
@BOX 5.0
NEXT
CHAR
@BOX 6.0
 E OR D?
@BOX 8.0
READ IN EXP
@BOX 9.0
ACC NO
@BOX 10.0
END NO
@BOX 11.0
FAULT
'STRANGE CHAR'
@BOX 12.0
OUT
@BOX 1.1
@BOX 2.1
; IF CHAR /= '.
@BOX 3.1
; IF DP /= 0
@BOX 4.1
; 1 => DP
@BOX 5.1
; -> NEXT.CHAR
@BOX 6.1
; IF CHAR /= 'E /= 'D
@BOX 8.1
; FIO.READ.INT(IBUFPTR,WIDTH,0) => EXPON
@BOX 9.1
; DEXP(EXPON*RQLOG10.0)*>X
; 1 => EXPON
@BOX 10.1
; -> END.NO
@BOX 11.1
; ENTER.TRAP(6,114)
@BOX 12.1
; -> OUT
@END
@TITLE FTN23.30(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
UF.I.READ
@BOX 2.0
INPUT INTEGER
@BOX 3.0
END
@BOX 1.1
; PROC FIO.UF.I32.READ
@BOX 2.1
; IN.BIN(4) => FIO.UF.I32.READ
@BOX 3.1
;END
@END
@TITLE FTN23.30.1(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
UF.I16.READ
@BOX 2.0
INPUT INTEGER
@BOX 3.0
END
@BOX 1.1
; PROC FIO.UF.I16.READ
@BOX 2.1
; IN.BIN(2) => FIO.UF.I16.READ
@BOX 3.1
END
@END
^L@TITLE FTN23.30.2(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
FIO.UF.I8.READ
@BOX 2.0
MOVE IN ONE BYTE
@BOX 3.0
END
@BOX 1.1
PROC FIO.UF.I8.READ;
@BOX 2.1
IN.CH() => FIO.UF.I8.READ;
@BOX 3.1
END;
@END
@TITLE FTN23.31(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
UF.R.READ
@BOX 2.0
INPUT REAL
@BOX 3.0
END
@BOX 1.1
; PROC FIO.UF.R.READ
@BOX 2.1
; IN.BIN(4) => FIO.UF.R.READ
@BOX 3.1
END
@END
@TITLE FTN23.32(1,6)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
UF.DP.READ
@BOX 2.0
INPUT DP
@BOX 3.0
END
@BOX 1.1
;PROC FIO.UF.DP.READ
;TYPE CONV IS $RE32 A, B OR $RE64 X
;CONV DP
@BOX 2.1
;IN.BIN(4) => A OF DP
;IN.BIN(4) => B OF DP
@BOX 3.1
;X OF DP => FIO.UF.DP.READ
END
@END
@TITLE FTN23.33(1,6)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
UF.C.READ
@BOX 2.0
INPUT COMPLEX
@BOX 3.0
END
@BOX 1.1
;PROC FIO.UF.C.READ(C)
@BOX 2.1
;IN.BIN(4) => R OF C^
;IN.BIN(4) => I OF C^
@BOX 3.1
END
@END
@TITLE FTN23.34(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
UF.L32.READ
@BOX 2.0
INPUT LOGICAL
@BOX 3.0
END
@BOX 1.1
; PROC FIO.UF.L32.READ
@BOX 2.1
; IN.BIN(4) => FIO.UF.L32.READ
@BOX 3.1
; END
@END
@TITLE FTN23.34.1(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
UF.L16.READ
@BOX 2.0
INPUT LOGICAL
@BOX 3.0
END
@BOX 1.1
; PROC FIO.UF.L16.READ
@BOX 2.1
; IN.BIN(2) => FIO.UF.L16.READ
@BOX 3.1
END
@END
^L@TITLE FTN23.34.2(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
FIO.UF.L8.READ
@BOX 2.0
MOVE IN ONE BYTE
@BOX 3.0
END
@BOX 1.1
PROC FIO.UF.L8.READ;
@BOX 2.1
IN.CH() => FIO.UF.L8.READ;
@BOX 3.1
END
@END
@TITLE FTN23.35(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
UF.STR.READ
@BOX 2.0
INPUT STRING
@BOX 3.0
END
@BOX 1.1
; PROC FIO.UF.STR.READ(STRING)
; $IN WIDTH
@BOX 2.1
; FOR WIDTH < SIZE(STRING) DO
   IN.CH() => STRING^[WIDTH] OD
@BOX 3.1
END
@END

