@X @~
~L3 COUK1247
80
~V7 56 2 -5
~D10
~H                    MUSS
~
~
~D10
~H             FTN241
~D10
~MMANCHESTER UNIVERSITY  -  CONFIDENTIAL~
~
~
                                                            ISSUE 10~
~V9 -1
~P
~V9 1
~YFTN241
~S1~M~OFORTRAN 77 I/O LIBRARY IMPLEMENTATION DESCRIPTION
~S1~M~OSection 24
~S1~OSection 24. Output Procedures
~S1~O1.1 General Description
~BThis section of the library contains the output procedures which
implement the Fortran WRITE and PRINT statements, possibly using the
Formats processed by section 22. Fortran output may be list-directed,
formatted or unformatted and routines in this section perform all
three kinds of output. All output is made to the currently selected
output stream, which was selected by the unit control routines in
section 27.
~S1~O1.2 Non Standard Features
~BAs described in section 23, this library implements the storage of
Hollerith Characters in arithmetic variables. They are written in the
recommended manner. The maximum number of characters that can be
stored in an arithmetic variable is four.
~BUnformatted output is implementation dependent on the size of each
storage item. At present unformatted integers and logicals are output
as one storage unit, reals as two, complex and double precision as
four. Character strings are output in byte units.
~BThe rouine FIO.OUT.CCC is implementation dependent and may be
altered to suit the carriage control conventions of a particular
system. It should be noted that a file written and then read back by
Fortran should appear to be unchanged, but when sent to a printer the
first character of each record should be stripped off and used for
carriage control.
~S1~O2. Interfaces
~S1~O2.1 Section Interfaces Used~
~
   Section 21:   (Configuration Section)~
   Section 23:   (Input Procedures)~
   Section 27:   (Unit Control Procedures)~
~S1~O2.2 Section Interface~
~
Library Procedures:~
   FIO.I.WRITE~
   FIO.R.WRITE~
   FIO.DP.WRITE~
   FIO.C.WRITE~
   FIO.L.WRITE~
   FIO.STR.WRITE~
   FIO.LD.I.WRITE~
   FIO.LD.R.WRITE~
   FIO.LD.DP.WRITE~
   FIO.LD.C.WRITE~
   FIO.LD.L.WRITE~
   FIO.LD.STR.WRITE~
   FIO.UF.I.WRITE~
   FIO.UF.R.WRITE~
   FIO.UF.DP.WRITE~
   FIO.UF.C.WRITE~
   FIO.UF.L.WRITE~
   FIO.UF.STR.WRITE~
   FIO.E.WRITE~
~S1~O3. Implementation
~S1~O3.1 Outline of Operation
~S1~OTypical code sequences for WRITE and PRINT statements~
~3
~
   WRITE(6,200)I,R~
   200 FORMAT(1X,I6,3X,F6.2)~
~
   Required code sequence is~
~
   FIO.SELECT.SEQ.UNIT(6, Refn. to FORMAT 200,NIL,8)~
   FIO.I.WRITE(I)~
   FIO.R.WRITE(R)~
   FIO.E.WRITE()~
~
~
   PRINT *, I, R~
~
~
Required code sequence is~
~
   FIO.SELECT.SEQ.UNIT(0,NIL,NIL,%1A)~
   FIO.LD.I.WRITE(I)~
   FIO.LD.R.WRITE(R)~
   FIO.E.WRITE()~
~0
~BThe first character of each record determines the control effect,
and after this, writing is according to the format specification.
~BThe records are terminated where appropriate, but ~Ware ~Wnot filled
out with blanks to the record length.
~S1~M~OFormatted Output
~
~
FIO.I.WRITE(INTEGER.VALUE)~
~
FIO.R.WRITE(REAL.VALUE)~
~
FIO.DP.WRITE(DOUBLE.PRECISION.VALUE)~
~
FIO.C.WRITE(COMPLEX.VALUE)~
~
FIO.L.WRITE(LOGICAL.VALUE)~
~BAll the above output VALUE according to the controlling format.
~S1FIO.STR.WRITE(STRING)
~BOutputs the string according to the controlling format.
~S1FIO.E.WRITE()
~BThis procedure terminates writing according to the controlling
format, and sets the reply word to zero to indicate a successful
WRITE.
~BIn formatted output the procedures FIO.WRITE.INTEGER and
FIO.WRITE.REAL are used to print out the appropriate values.
~S1~M~OList Directed Output
~
~
FIO.LD.I.WRITE(INTEGER.VALUE)~
~
FIO.LD.R.WRITE(REAL.VALUE)~
~
FIO.LD.DP.WRITE(DOUBLE.PRECISION.VALUE)~
~
FIO.LD.C.WRITE(COMPLEX.VALUE)~
~
FIO.LD.L.WRITE(LOGICAL.VALUE)~
~
FIO.LD.STR.WRITE(STRING)~
~BAll the above procedures print the value of the output item.
~BFour of the list-directed output routines set up an appropriate
entry in the format table and then the item is printed unde format
control. In the procedure FIO.LD.I.WRITE the width of the integer
is calculated and an appropriate format generated and the formatted
output is performed. In FIO.LD.R.WRITE a format of G15.6 is used, and
FIO.LD.DP.WRITE converts the double precision to a real and uses the same
method; complex constants from LD.C.WRITE also use a G edit descriptor.
~BThe procedures FIO.LD.L.WRITE and FIO.LD.STR.WRITE do not use formatted output
,
but print the value directly generating a T (for true), F (for false)
or a string of characters respectively. A string of characters may
be printed on as many records as necessary, but with each such record
having its beginning a blank character for carriage control.
~S1~M~OUnformatted Output
~S1FIO.UF.I.WRITE(INTEGER.VALUE)
~S1FIO.UF.R.WRITE(REAL.VALUE)
~S1FIO.UF.DP.WRITE(DOUBLE.PRECISION.VALUE)
~S1FIO.UF.C.WRITE(COMPLEX.VALUE)
~S1FIO.UF.L.WRITE(LOGICAL.VALUE)
~S1FIO.UF.STR.WRITE(STRING)
~BAll the above output the unformatted value.
~S1~O3.1.2 Internal Procedures
~S1FIO.O.WRITE(IO.LIST)~
~BProcesses the current format until a field descriptor of type
A,I,D,E,F,G, or 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.~
~S1FIO.UNPACK.EXP(INT,E)EXP.WIDTH~
~BUnpacks the integer exponent into the DIGITS vectors, and adds
leading zeroes, sign and E where necessary.~
~3
~
~
Parameters:-~
~
INT        Value of exponent~
E          Exponent part of Field descriptor~
EXP.WIDTH  -1 Exponent field too small~
           >0 Width in chars of unpacked exponent.~
~0
~S1FIO.WRITELAYOUT(W,D,SIGN,INT)STATUS~
~BOutputs for a real or a double precision, provided the field
width is not too small, the following:~
~3
~T# 12
~
#1) Leading status required~
#2) Sign if required~
#3) Zero if item < 1 and sufficient width~
#4) Decimal point.~
#   If width is insufficient then asterisks output.~
~S1Parameters:-~
~
W         Field width~
D         Fractional digits~
SIGN      0/1 positive/negative items~
INT       Exponent of item~
STATUS    0- OK 1- W too small~
~0
~S1FIO.OUT.CHAR(CHAR)~
~BIf the character is the first of a record it is treated as a
carriage control character, otherwise the character  is output.
Output beyond the end of a record is trapped, prior to calling this
procedure the remaining character count for the record is to be
updated.~
~S1FIO.OUT.CHARS(CHAR,N)~
~BOutputs a character N times (N may be =<0). Carriage control and
fault action are as in OUT.CHAR.
~S1FIO.WRITE.HOLL(HOLL,WIDTH)
~BOutputs the Hollerith characters stored in an arithmetic variable
to the specified width.
~S1FIO.OUT.CCC(CHAR)
~BOutputs a carriage control character. Special action is taken
if this is the first character output for a unit. This procedure
is implementation dependent. Fortran carriage control characters
are only meaningfull when the output is sent to a pointer. When
the output is sent to a file they are ordinary characters. If a
file produced by a Fortran program is listed on a printer the
carriage control characters are meaningfull again! See LIST in
section 26.
~S1FIO.OUT.SEPARATOR(WIDTH)~
~BIf there is enough record space remaining for WIDTH characters
then a space separator is output, unless the last item output was a
string in which case no separator is output. If insufficient record
space then a new record is written.~
~S1FIO.WRITE.INTEGER(INT)~
~BOutputs an integer according to the current control format
descriptor.~
~S1FIO.WRITE.REAL(REAL)~
~BOutputs a real according to the current control format
descriptor.~
~S1FIO.WRITE.CONST(X,W,D,SIGN,EXP)STATUS~
~BOutputs the real data item provided field width is not
too small, as follows~
~3
~
~M1) leading spaces if required~
~N2) sign if required~
~N3) integer part of X, zero or nothing~
~N4) decimal point~
~N5) fractional part of X if required.~
~
~
Parameters:-~
~
~MX      Real to be printed in normalised form~
~NW      Width~
~ND      Fractional width~
~NSIGN   0/1 Positive/negative~
~NEXP    Exponent of normalised real~
~NSTATUS 0/1 OK/field too small~
~0
~S1FIO.NORMALISE(X)X.NORM~
~BNormalises the real item X so that~
~3
~
~M           0.1 ~C< X.NORM < 1, and~
~NX.NORM * 10**EXP=X. The exponent is set in PW1~
~0
~S1FIO.WRITE.DP.REAL(REAL)~
~BOutputs a double precision item according to the current control
format descriptor.~
~S1FIO.DP.WRITE.CONST(X,W,D,SIGN,EXP)STATUS~
~BSpecification as FIO.WRITE.CONST except X is a double precision item.~
~S1FIO.DP.NORMALISE(X)X.NORM~
~BNormalises the double precision item X so that 0.1~C< X.NORM <1,
and X.NORM* 10**EXP=X. The exponent is set in PW1.
~S1~O3.2  Data Structures~
~
~3
~T# 17
~
CCC~I= 0  CCC not written in current output record~
~I= 1  CCC written~
~
LAST.ITEM~I= 1  indicates last item output was a string~
~
POS.S~I= 0  '+' not produced on output of positive items~
~I= 1  '+' produced.~
~
HIGH.TIDE.MARK~Icontains the byte pointer of the farthest point
reached in outputting a line. It is used in conjunction with the
T, TL and TR editing formats which manipulate the lines byte pointer.~
~0
~Y
~V9 -1
~P
~D15
~HFLOWCHARTS
~
~
~H                FTN241
~V9 -1
~F
@TITLE FTN24(1,11)
@COL 1S-2R-3R-4R-5R-6R
@COL 7R-9F
@FLOW 1-2-3-4-5-6-7-9
@BOX 1.0
OUTPUT SECTION
@BOX 2.0
[IMPORTS FTN24/1]
MODULE HEADING
@BOX 3.0
TYPE DECLARATION
@BOX 4.0
LITERAL DECLARATIONS
@BOX 5.0
SCALAR DECLARATIONS
@BOX 6.0
VECTOR DECLARATIONS
@BOX 7.0
PROCEDURES IN MODULE
  FORMATTED OUTPUT
   FTN24.2 INTEGER WRITE
   FTN24.3 REAL WRITE
   FTN24.4 DOUBLE PRECISION WRITE
   FTN24.5 COMPLEX WRITE
   FTN24.6 LOGICAL WRITE
   FTN24.7 STR. WRITE
  LIST DIRECTED OUTPUT
   FTN24.20 INTEGER WRITE
   FTN24.21 REAL WRITE
   FTN24.22 D.P WRITE
   FTN24.23 COMPLEX WRITE
   FTN24.24 LOGICAL WRITE
   FTN24.25 STRING WRITE
  UNFORMATTED OUTPUT
   FTN24.30 INTEGER WRITE
   FTN24.31 REAL WRITE
   FTN24.32 DP WRITE
   FTN24.33 COMPLEX WRITE
   FTN24.34 LOGICAL WRITE
   FTN24.35 STRING WRITE
   FTN24.8 END WRITE
  PROCS USED BY ABOVE
   FTN24.9.0 WRITE
   FTN24.10 WRITE EXP
   FTN24.13 WRITE LAYOUT
   FTN24.14 END.REC
   FTN24.15 OUT.CHARS
   FTN24.16 WRITE.HOLL
   FTN24.17 SEC.FLD
   FTN24.26 OUT.SEPARATOR
   FTN24.40 WRITE.INT
   FTN.24.41 WRITE.REAL
   FTN24.41.2 WRITE.CONST
   FTN24.41.3 NORMALISE
   FTN24.42 WRITE.DP
   FTN24.42.2 DP.WRITE.CONST
   FTN24.42.3 DP.NORMALISE
@BOX 9.0
END
@BOX 2.1
#FTN24/1
;MODULE (FIO.I.WRITE,FIO.I8.WRITE,FIO.I16.WRITE,FIO.I32.WRITE,
   FIO.L.WRITE,FIO.L8.WRITE,FIO.L16.WRITE,FIO.L32.WRITE,
   FIO.R.WRITE,FIO.DP.WRITE,FIO.C.WRITE,FIO.STR.WRITE,
   FIO.LD.I8.WRITE,FIO.LD.I16.WRITE,FIO.LD.I32.WRITE,
   FIO.LD.R.WRITE,FIO.LD.DP.WRITE,FIO.LD.C.WRITE,
   FIO.LD.L8.WRITE,FIO.LD.L16.WRITE,FIO.LD.L32.WRITE,
   FIO.LD.STR.WRITE,FIO.UF.I32.WRITE,FIO.UF.R.WRITE,
   FIO.UF.DP.WRITE,FIO.UF.C.WRITE,FIO.UF.L32.WRITE,FIO.LD.I.WRITE,
   FIO.UF.STR.WRITE,FIO.E.WRITE,FIO.UF.I16.WRITE,FIO.LD.L.WRITE,
   FIO.UF.I8.WRITE,FIO.UF.L16.WRITE,FIO.UF.L8.WRITE);
@BOX 3.1
::NONE
@BOX 4.1
;LITERAL/ADDR UNIT NIL =
@BOX 5.1
; *GLOBAL 5
;$IN LAST.ITEM
@BOX 6.1
;$LO8[64] DIGITS
; *GLOBAL 0
@BOX 7.1
;L.SPEC FIO.I8.WRITE($IN8)
;L.SPEC FIO.I16.WRITE($IN16)
;L.SPEC FIO.I32.WRITE($IN32)
;L.SPEC FIO.I.WRITE($IN32,$LO8)
;L.SPEC FIO.L8.WRITE($LO8)
;L.SPEC FIO.L16.WRITE($LO16)
;L.SPEC FIO.L32.WRITE($LO32)
;L.SPEC FIO.L.WRITE($LO32,$LO8)
;L.SPEC FIO.UF.I32.WRITE($IN32)
;L.SPEC FIO.UF.I16.WRITE($IN16)
;L.SPEC FIO.UF.I8.WRITE($IN8)
;L.SPEC FIO.UF.L32.WRITE($LO32)
;L.SPEC FIO.UF.L16.WRITE($LO16)
;L.SPEC FIO.UF.L8.WRITE($LO8)
;L.SPEC FIO.R.WRITE($RE32)
;L.SPEC FIO.DP.WRITE($RE64)
;L.SPEC FIO.C.WRITE(ADDR COMPLEX)
;L.SPEC FIO.STR.WRITE(ADDR[$LO8])
;L.SPEC FIO.LD.I.WRITE($IN32)
;L.SPEC FIO.LD.I8.WRITE($IN8)
;L.SPEC FIO.LD.I16.WRITE($IN16)
;L.SPEC FIO.LD.I32.WRITE($IN32)
;L.SPEC FIO.LD.R.WRITE($RE32)
;L.SPEC FIO.LD.DP.WRITE($RE64)
;L.SPEC FIO.LD.C.WRITE(ADDR COMPLEX)
;L.SPEC FIO.LD.L.WRITE($LO32)
;L.SPEC FIO.LD.L8.WRITE($LO8)
;L.SPEC FIO.LD.L16.WRITE($LO16)
;L.SPEC FIO.LD.L32.WRITE($LO32)
;L.SPEC FIO.LD.STR.WRITE(ADDR[$LO8])
;L.SPEC FIO.UF.R.WRITE($RE32)
;L.SPEC FIO.UF.DP.WRITE($RE64)
;L.SPEC FIO.UF.C.WRITE(ADDR COMPLEX)
;L.SPEC FIO.UF.STR.WRITE(ADDR[$LO8])
;L.SPEC FIO.E.WRITE()
;P.SPEC FIO.O.WRITE($IN)
;P.SPEC FIO.UNPACK.EXP($IN,$IN)/$IN
;P.SPEC FIO.WRITE.LAYOUT($IN,$IN,$IN,$IN)/$IN
;P.SPEC FIO.END.REC()
;P.SPEC FIO.SEL.FLD($IN)
;P.SPEC FIO.OUT.CHARS($IN,$IN)
;P.SPEC FIO.WRITE.HOLL($LO64,$IN)
;P.SPEC FIO.OUT.SEPARATOR($IN)
;P.SPEC FIO.WRITE.INTEGER($IN32)
;P.SPEC FIO.WRITE.REAL($RE32)
;P.SPEC FIO.WRITE.CONST($RE32,$IN,$IN,$IN,$IN)/$IN
;P.SPEC FIO.NORMALISE($RE32)/$RE32
;P.SPEC FIO.WRITE.DP.REAL($RE64)
;P.SPEC FIO.DP.WRITE.CONST($RE64,$IN,$IN,$IN,$IN)/$IN
;P.SPEC FIO.DP.NORMALISE($RE64)/$RE64
#FTN24.20
#FTN24.24
#FTN24.2.1
#FTN24.2.2
#FTN24.2.3
#FTN24.6.1
#FTN24.6.2
#FTN24.6.3
#FTN24.20.1
#FTN24.20.2
#FTN24.20.3
#FTN24.24.1
#FTN24.24.2
#FTN24.24.3
#FTN24.30.2
#FTN24.34.2
#FTN24.2
#FTN24.3
#FTN24.4
#FTN24.5
#FTN24.6
#FTN24.7
#FTN24.21
#FTN24.22
#FTN24.23
#FTN24.25
#FTN24.30
#FTN24.30.1
#FTN24.31
#FTN24.32
#FTN24.33
#FTN24.34
#FTN24.34.1
#FTN24.35
#FTN24.8
#FTN24.9
#FTN24.10
#FTN24.13
#FTN24.14
#FTN24.15
#FTN24.16
#FTN24.17
#FTN24.26
#FTN24.40
#FTN24.41
#FTN24.41.2
#FTN24.41.3
#FTN24.42
#FTN24.42.2
#FTN24.42.3
@BOX 9.1
;*END
@END
@TITLE FTN24/1(1,11)
@COL 1S-2R-3R-4R-5R-6R-7F
@FLOW 1-2-3-4-5-6-7
@BOX 1.0
OUTPUT 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
;TYPE COMPLEX IS $RE32 R, I
@BOX 3.1
;IMPORT LITERAL CONTROL.CHAR.Z.L,BYTE.PER.S.L,FMT.NEST.LIMIT,BITS.PER.S.L,
  TRUE.L,FMT.G15.8L,FMT.E15.6E4L,R.FMT.LIMIT,BYTE.PER.D.L,BITS.PER.R.L,MAX.INT.W
IDTH.L
;IMPORT LITERAL $LO8 SPACE.L
;IMPORT LITERAL $RE RD10.0,RD0.1,RD1.0,RD0.0,RDLOG10.0,RD0.5,RDLOG0.1
;IMPORT LITERAL $RE64  RQ10.0,RQ0.1,RQ1.0,RQ0.0,RQLOG10.0,RQLOG0.1,RQ0.5
;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[$LO8] CHAR.CONST.TBL
;ADDR PW1
;$IN CUR.FMT,REP.CNT,FMT.NEST,
     SCF,POS.S,REC,GRP.CNT
;$IN32 S.POS,E.POS,C.POS,T.POS
;$IN REST.REQ
;ADDR UNIT CUR.UNIT
;UNIT IN.RES
;$IN[CONTROL.CHAR.Z.L] CONTROL.CHAR
;$IN[FMT.NEST.LIMIT]FMT.STACK
;$IN16[8] LD.FMT.TBL
;$IN16 [R.FMT.LIMIT] R.FMT.TBL
;$LO8[8] HOLL.ARRAY
@BOX 6.1
;L.SPEC O.REC()/$IN32
;L.SPEC OUT.REC()
;L.SPEC NEWLINES($IN)
;L.SPEC SET.O.POS($IN32)
;L.SPEC O.POS()/$IN32
;L.SPEC OUT.CH($IN)
;L.SPEC OUT.BIN($LO32, $IN)
;L.SPEC DEXP($RE64)/$RE64
;L.SPEC EXP($RE32)/$RE32
;L.SPEC END.OUTPUT($IN,$IN)
;L.SPEC OUT.BACK.SPACE($IN)
;L.SPEC SPACES($IN)
;L.SPEC ENTER.TRAP($IN, $IN)
@END
@TITLE FTN24.2(1,11)
@COL 1S-3R-5R-20T-6T-8T-9R
@COL 10N-12R
@COL 21R-13R-14T-15R-16F
@COL 17R
@ROW 6-10-21
@ROW 8-13
@ROW 9-12
@ROW 15-17
@FLOW 1-3-5-20N-6N-8N-9-5
@FLOW 6YES-10-13-14NO-15-16
@FLOW 8YES-12-16
@FLOW 20YES-21-14YES-17-16
@BOX 1.0
PROC I WRITE
@BOX 3.0
DECLARATIONS
@BOX 5.0
PICK UP FORMAT
@BOX 20.0
A?
@BOX 6.0
I?
@BOX 8.0
DEFGL?
@BOX 9.0
OWRITE :4.9:
IOLIST
@BOX 12.0
FAULT
'FIELD DESCRIPTOR'
@BOX 21.0
WRITE HOLL:4.16:
@BOX 13.0
WRITE INT :4.40:
@BOX 14.0
REPEAT?
@BOX 15.0
NEXT FORMAT
@BOX 16.0
FINISH
@BOX 17.0
RC - 1
@BOX 1.1
;PROC FIO.I.WRITE(INT,STORAGE)
@BOX 3.1
;INTEGER FD,N
@BOX 5.1
;FMT.TBL^[CUR.FMT] => FD
@BOX 20.1
; IF FD = 2
@BOX 6.1
;IF FD = 1
@BOX 8.1
;IF FD > 0
@BOX 9.1
;FIO.O.WRITE(0)
@BOX 12.1
;ENTER.TRAP(6,101)
@BOX 21.1
; FIO.WRITE.HOLL(INT,STORAGE)
; 2 => N
@BOX 13.1
;FIO.WRITE.INTEGER(INT)
; 3 => N
@BOX 14.1
;  IF REP.CNT /= 0
@BOX 15.1
;  N +> CUR.FMT
@BOX 17.1
;1 -> REP.CNT
@BOX 16.1
END
@END
^L@TITLE FTN24.2.1(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
FIO.I8.WRITE
@BOX 2.0
CALL FIO.I.WRITE(INT,I8.SIZE.L)
@BOX 3.0
END
@BOX 1.1
;PROC FIO.I8.WRITE(INT)
@BOX 2.1
;FIO.I.WRITE(INT,I8.SIZE.L)
@BOX 3.1
;END
@END
^L@TITLE FTN24.2.2(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
FIO.I16.WRITE
@BOX 2.0
CALL FIO.I.WRITE(INT,I16.SIZE.L)
@BOX 3.0
END
@BOX 1.1
;PROC FIO.I16.WRITE(INT)
@BOX 2.1
;FIO.I.WRITE(INT,I16.SIZE.L)
@BOX 3.1
;END
@END
^L@TITLE FTN24.2.3(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
FIO.I32.WRITE
@BOX 2.0
CALL FIO.I.WRITE(INT,I32.SIZE.L)
@BOX 3.0
END
@BOX 1.1
;PROC FIO.I32.WRITE(INT)
@BOX 2.1
;FIO.I.WRITE(INT,I32.SIZE.L)
@BOX 3.1
;END
@END
@TITLE FTN24.3(1,11)
@COL 1S-5R-20T-6T-8T-9R
@COL 10N-12R
@COL 21R-13R-14T-15R-16F
@COL 17R
@ROW 6-10-21
@ROW 9-12
@ROW 15-17
@ROW 13-8
@FLOW 1-5-20N-6N-8N-9-5
@FLOW 6YES-10-13-14NO-15-16
@FLOW 8YES-12-16
@FLOW 20YES-21-14YES-17-16
@BOX 1.0
PROC RWRITE
@BOX 5.0
PICK UP FORMAT
@BOX 20.0
A?
@BOX 6.0
DEFG?
@BOX 8.0
IL?
@BOX 9.0
OWRITE :4.9:
IO LIST
@BOX 12.0
FAULT
'FIELD DESCRIPTOR'
@BOX 21.0
WRITE HOLL :4.16:
@BOX 13.0
WRITE REAL :4.41:
@BOX 14.0
REPEAT?
@BOX 15.0
NEXT FORMAT
@BOX 16.0
FINISH
@BOX 17.0
RC - 1
@BOX 1.1
;PROC FIO.R.WRITE(REAL.X)
;INTEGER FD,N
@BOX 5.1
;FMT.TBL^[CUR.FMT] => FD
@BOX 20.1
; IF FD = 2
@BOX 6.1
;IF FD >= 4 AND FD =< 6
@BOX 8.1
;IF FD > 0
@BOX 9.1
;FIO.O.WRITE(0)
@BOX 12.1
;ENTER.TRAP(6,101)
@BOX 21.1
; FIO.WRITE.HOLL(REAL.X,I32.SIZE.L)
; 2 => N
@BOX 13.1
;FIO.WRITE.REAL(REAL.X)
; 4 => N
@BOX 14.1
;IF REP.CNT /= 0
@BOX 15.1
;N +> CUR.FMT
@BOX 17.1
;1 -> REP.CNT
@BOX 16.1
END
@END
@TITLE FTN24.4(1,11)
@COL 1S-5R-20T-6T-7T-8R
@COL 9N-10R
@COL 21R-11R-12T-13R-14F
@COL 15R
@ROW 6-9-21
@ROW 13-15
@ROW 8-10
@ROW 7-11
@FLOW 1-5-20N-6N-7N-8-5
@FLOW 20Y-21-12
@FLOW 6YES-9-11-12NO-13-14
@FLOW 7YES-10-14
@FLOW 12YES-15-14
@BOX 1.0
PROC DPWRITE
@BOX 5.0
PICK UP FORMAT
@BOX 6.0
DEFG?
@BOX 7.0
IL?
@BOX 8.0
0WRITE :4.9:
IOLIST
@BOX 10.0
FAULT
'FIELD DESCRIPTOR'
@BOX 11.0
WRITE DBLE :4.42:
@BOX 12.0
REPEAT?
@BOX 13.0
NEXT FORMAT
@BOX 14.0
FINISH
@BOX 15.0
RC - 1
@BOX 20.0
A?
@BOX 21.0
WRITE HOLL:24.16:
@BOX 1.1
;PROC FIO.DP.WRITE(DP)
;$IN FD,N,WID,ST
@BOX 5.1
;FMT.TBL^[CUR.FMT] => FD
@BOX 6.1
;IF FD >= 4 AND FD =< 6
@BOX 7.1
;IF FD > 0
@BOX 8.1
;FIO.O.WRITE(0)
@BOX 10.1
;ENTER.TRAP(6,101)
@BOX 11.1
;FIO.WRITE.DP.REAL(DP)
; 4=> N
@BOX 12.1
 ;IF REP.CNT /= 0
@BOX 13.1
;N +> CUR.FMT
@BOX 15.1
;1 -> REP.CNT
@BOX 14.1
END
@BOX 20.1
;IF FD = 2
@BOX 21.1
;IF FMT.TBL^[CUR.FMT+1] => ST > 0 AND ST  =< I32.SIZE.L THEN
   ; I32.SIZE.L => ST
; ELSE
   ; I64.SIZE.L  => ST
; FI
; FIO.WRITE.HOLL(DP, ST)
; 2 => N
@END
@TITLE FTN24.5(1,6)
@COL 1S-3R-6R-7R-8F
@FLOW 1-3-6-7-8
@BOX 1.0
PROC CWRITE
@BOX 3.0
DECLARATIONS
@BOX 6.0
RWRITE
REAL
@BOX 7.0
RWRITE
IMAG
@BOX 8.0
FINISH
@BOX 1.1
;PROC FIO.C.WRITE(COMP)
@BOX 3.1
@BOX 6.1
;FIO.R.WRITE(R OF COMP^)
@BOX 7.1
;FIO.R.WRITE(I OF COMP^)
@BOX 8.1
END
@END
@TITLE FTN24.6(1,11)
@COL 1S-3R-5R-30T-6T-7T-8R
@COL 9N-10R
@COL 31R-11R-17R-18T-19R-20T-21R-22F
@COL 25R-26R
@ROW 10-20
@ROW 7-11
@ROW 6-9-31
@ROW 19-25
@ROW 21-26
@FLOW 1-3-5-30N-6N-7N-8-5-30Y-31-20N-21-22
@FLOW 6Y-11-17-18N-19-20Y-26-22
@FLOW 7Y-10-22
@FLOW 18Y-25-20
@BOX 1.0
PROC LWRITE
@BOX 3.0
DECLARATIONS
@BOX 5.0
PICK UP FORMAT
@BOX 30.0
A?
@BOX 6.0
L?
@BOX 7.0
DEFGI?
@BOX 8.0
OWRITE
IOLIST
@BOX 10.0
FAULT
'FIELD DESCRIPTOR'
@BOX 31.0
WRITE HOLL :4.16:
@BOX 11.0
PICK UP WIDTH
SELECT RECORD FIELD
@BOX 17.0
SPACES
@BOX 18.0
TRUE?
@BOX 19.0
CHAR F
@BOX 25.0
CHAR T
@BOX 20.0
REPEAT?
@BOX 21.0
NEXT FORMAT
@BOX 26.0
RC - 1
@BOX 22.0
FINISH
@BOX 1.1
; PROC FIO.L.WRITE(LOG,STORAGE)
@BOX 3.1
;INTEGER WIDTH,FD
@BOX 5.1
;FMT.TBL^[CUR.FMT] => FD
@BOX 30.1
; IF FD = 2
@BOX 6.1
;IF FD=3
@BOX 7.1
;IF FD > 0
@BOX 8.1
;FIO.O.WRITE(0)
@BOX 10.1
;ENTER.TRAP(6,101)
@BOX 31.1
; FIO.WRITE.HOLL(LOG,STORAGE)
@BOX 11.1
;FIO.SEL.FLD(FMT.TBL^[CUR.FMT+1] => WIDTH)
@BOX 17.1
;SPACES(WIDTH-1)
@BOX 18.1
;IF LOG = TRUE.L
@BOX 19.1
;OUT.CH('F)
@BOX 25.1
;OUT.CH('T)
@BOX 20.1
;IF REP.CNT /= 0
@BOX 21.1
;2 +> CUR.FMT
@BOX 26.1
;1 -> REP.CNT
@BOX 22.1
END
@END
^L@TITLE FTN24.6.1(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
FIO.L8.WRITE
@BOX 2.0
CALL FIO.L.WRITE(LOG,I8.SIZE.L)
@BOX 3.0
END
@BOX 1.1
;PROC FIO.L8.WRITE(LOG)
@BOX 2.1
;FIO.L.WRITE(LOG,I8.SIZE.L)
@BOX 3.1
;END
@END
^L@TITLE FTN24.6.2(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
FIO.L16.WRITE
@BOX 2.0
CALL FIO.L.WRITE(LOG,I16.SIZE.L)
@BOX 3.0
END
@BOX 1.1
;PROC FIO.L16.WRITE(LOG)
@BOX 2.1
;FIO.L.WRITE(LOG,I16.SIZE.L)
@BOX 3.1
;END
@END
^L@TITLE FTN24.6.3(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
FIO.L32.WRITE
@BOX 2.0
CALL FIO.L.WRITE(LOG,I32.SIZE.L)
@BOX 3.0
END
@BOX 1.1
;PROC FIO.L32.WRITE(LOG)
@BOX 2.1
;FIO.L.WRITE(LOG,I32.SIZE.L)
@BOX 3.1
;END
@END
@TITLE FTN24.7(1,11)
@COL 1S-20R-21T-6R-7T-8T-10R-14R-15T-16R-17F
@COL 22T-23R-9R-18R
@COL 24R-25C
@ROW 6-22
@ROW 23-24
@ROW 16-18
@FLOW 1-20-21N-6-7N-8N-10-14-15N-16-17
@FLOW 21Y-22N-23-20
@FLOW 22Y-24-25
@FLOW 7Y-9-8Y-14
@FLOW 15Y-18-17
@BOX 1.0
PROC STR. WRITE
@BOX 6.0
PICK UP WIDTH
SET STRING LENGTH
@BOX 7.0
WIDTH=0?
@BOX 8.0
SELECT RECORD FIELD
W=<LEN?
@BOX 9.0
WIDTH=LENGTH
@BOX 10.0
SPACES
@BOX 14.0
OUTPUT
STRING
@BOX 15.0
REPEAT?
@BOX 16.0
NEXT FORMAT
@BOX 18.0
RC-1
@BOX 20.0
PICK-UP FORMAT
@BOX 21.0
NOT A
@BOX 22.0
DEFGIL?
@BOX 23.0
OWRITE:4.9
@BOX 24.0
FAULT
'WRONG FIELD
DESCRIPTOR'
@BOX 25.0
END
@BOX 17.0
FINISH
@BOX 1.1
;PROC FIO.STR.WRITE(STRING)
;INTEGER WIDTH,LENGTH,I
;INTEGER FD
@BOX 6.1
;FMT.TBL^[CUR.FMT+1] => WIDTH
;SIZE(STRING) => LENGTH
@BOX 7.1
;IF WIDTH = 0
@BOX 8.1
;FIO.SEL.FLD(WIDTH)
;IF WIDTH =< LENGTH
@BOX 9.1
;LENGTH => WIDTH
@BOX 10.1
;SPACES(WIDTH-LENGTH)
;LENGTH => WIDTH
@BOX 14.1
;FOR I < WIDTH DO OUT.CH(STRING^[I]) OD
@BOX 15.1
;IF REP.CNT > 0
@BOX 20.1
;FMT.TBL^[CUR.FMT] => FD
@BOX 21.1
;IF FD /= 2
@BOX 22.1
;IF FD > 0
@BOX 23.1
;FIO.O.WRITE(0)
@BOX 24.1
;ENTER.TRAP(6,101)
@BOX 25.1
EXIT
@BOX 16.1
;2 +> CUR.FMT
@BOX 17.1
END
@BOX 18.1
1 -> REPCNT
@END
@TITLE FTN24.8(1,11)
@COL 1S-4T-5R-6T-7R-20R-22R-23T-21R-19R-30R-8F
@FLOW 1-4N-5-6NO-7-20-22-23N-21-19-30-8
@FLOW 4Y-22
@FLOW 23Y-19
@FLOW 6Y-20
@BOX 1.0
PROC E WRITE
@BOX 4.0
LD OR UNF?
@BOX 5.0
PICK UP FORMAT
@BOX 6.0
FIELD DESC?
@BOX 7.0
O WRITE :4.9:
NO IOLIST
@BOX 30.0
RESET TRAPS
@BOX 8.0
FINISH
@BOX 19.0
SET WRITTEN STATUS
@BOX 20.0
SET POSITION
TO LAST CHARACTER WRITTEN
@BOX 21.0
END OUTPUT
RELEASE STREAM
@BOX 22.0
END OUTPUT RECORD :24.14:
@BOX 23.0
NOT INTERNAL FILE
@BOX 1.1
;PROC FIO.E.WRITE
;INTEGER FD
@BOX 4.1
;IF CUR.FMT < 0
@BOX 5.1
;FMT.TBL^[CUR.FMT] => FD
@BOX 6.1
;  IF FD > 0
@BOX 7.1
;FIO.O.WRITE(1)
@BOX 30.1
; 0 => REST.REQ
@BOX 8.1
END
@BOX 19.1
; %4401 !> STATUS OF CUR.UNIT^
@BOX 20.1
;IF C.POS < T.POS THEN
   ;SET.O.POS(T.POS)
;FI
;T.POS => C.POS
@BOX 21.1
; END.OUTPUT(STREAM.NO OF IN.RES,1)
@BOX 22.1
; FIO.END.REC()
@BOX 23.1
; IF CUR.UNIT /= NIL
@END
@TITLE FTN24.9(1,11)
@COL 1S-3R-5R-6R-7R-9R-17R-18R-23R
@COL 10R-11R-12R-13R-14R-15R-16R-24R-22C-19R-20T-21F
@ROW 3-10
@FLOW 1-3-5-6-7-9-17-18-23-10-11-12-13-14-15-16-24-22-19-20N-21
@FLOW 20YES-6
@BOX 1.0
PROC 0 WRITE
@BOX 3.0
DECLARATIONS
@BOX 5.0
NOTE FORMAT
@BOX 6.0
PICK UP FORMAT
@BOX 7.0
SWITCH ON FORMAT
@BOX 9.0
H AND APOSTROPHE:4.9.2
@BOX 10.0
REPEAT COUNT
@BOX 11.0
SLASHES
END RECORD :24.14:
SET UP NEXT RECORD
@BOX 12.0
SCALE FACTOR
@BOX 13.0
START OF FORMAT
@BOX 14.0
END OF FORMAT :4.9.3:
@BOX 15.0
START OF GROUP
@BOX 16.0
END OF GROUP :4.9.4:
@BOX 17.0
S
@BOX 18.0
T:4.9.7
TR
LR
@BOX 24.0
BN, BZ
NO EFFECT
@BOX 22.0
RTN
PT
@BOX 23.0
COLON:4.9.6
@BOX 19.0
NEXT FORMAT
@BOX 20.0
0 WRITE?
@BOX 21.0
FINISH
@BOX 1.1
;PROC FIO.O.WRITE(NO.IO.LIST)
@BOX 3.1
;INTEGER SP,FPTR,WIDTH,FD,N,CHAR,PTR,RC,T,NEWLEN,
     GAP,NO.SPACES
; $IN32 POS
@BOX 5.1
; CUR.FMT => FPTR
@BOX 6.1
;0 - FMT.TBL^[CUR.FMT] => FD
; 2 => N
@BOX 7.1
;SWITCH FD \
    STRING,
    START.FORMAT,
    END.FORMAT,
    START.GROUP,
    END.GROUP,
    REPEAT.COUNT,
    SCALE.FACTOR,
       X,
    NO.EFFECT,
    SLASHES,
       S,
    COLON,
    TR,
    TL,
    T.SW
@BOX 9.1
#FTN24.9.2
@BOX 10.1
;REPEAT.COUNT : FMT.TBL^[CUR.FMT+1] => REP.CNT
; -> RTN.PT
@BOX 11.1
;SLASHES:
; 1 => N
; FIO.END.REC()
; O.POS() => S.POS => T.POS => C.POS + REC => E.POS
; -> RTN.PT
@BOX 12.1
;SCALE.FACTOR : FMT.TBL^[CUR.FMT+1] => SCF
; -> RTN.PT
@BOX 13.1
;START.FORMAT :
 0 => REP.CNT => SCF => POS.S => FMT.NEST
;   -> RTN.PT
@BOX 14.1
#FTN24.9.3
@BOX 15.1
;START.GROUP :
 GRP.CNT => FMT.STACK[FMT.NEST]
; 0 => GRP.CNT
; 1 +> FMT.NEST
;  -> RTN.PT
@BOX 16.1
#FTN24.9.4
@BOX 17.1
;S : FMT.TBL^[CUR.FMT+1] => POS.S
; -> RTN.PT
@BOX 18.1
#FTN24.9.7
@BOX 22.1
;RTN.PT :
@BOX 23.1
#FTN24.9.6
@BOX 19.1
;N +> CUR.FMT
@BOX 20.1
;IF FMT.TBL^[CUR.FMT] =< 0
@BOX 21.1
END
@BOX 24.1
;NO.EFFECT:
@END
@TITLE FTN24.9.2(1,11)
@COL 1S-3R-10R-11F
@FLOW 1-3-10-11
@BOX 1.0
PROC 0WRITE:HOLLERITH AND APOSTROPHE
@BOX 3.0
PICK UP WIDTH
AND HOLL POS
SELECT RECORD FIELD
@BOX 10.0
PRINT CHARS
@BOX 11.0
RTN
PT
@BOX 1.1
;STRING:
@BOX 3.1
;FIO.SEL.FLD(FMT.TBL^[CUR.FMT+1] => WIDTH)
;FMT.TBL^[CUR.FMT+2] => PTR
@BOX 10.1
;FOR WIDTH DO OUTCH(CHAR.CONST.TBL^[1+>PTR-1]) OD
@BOX 11.1
;3 => N
;-> RTN.PT
@END
@TITLE FTN24.9.3(1,11)
@COL 1S-3T-4R-6T-7R-10R-8R-11R-12C
@COL 9C
@ROW 4-9
@FLOW 1-3NO-4-6NO-7-10-8-11-12
@FLOW 3YES-9
@FLOW 6YES-10
@BOX 1.0
PROC OWRITE : END OF FORMAT
@BOX 3.0
NO IO LIST?
@BOX 4.0
RESET FORMAT
@BOX 6.0
NOT LOOPING?
@BOX 7.0
FAULT
'NO FD
FOR IOLIST'
@BOX 10.0
MOVE START
POINTER
@BOX 11.0
ADVANCE TIDE MARK
SET UP NEXT RECORD
@BOX 9.0
EXIT
@BOX 8.0
END RECORD
:24.14:
@BOX 12.0
RTN PT
@BOX 1.1
;END.FORMAT:
@BOX 3.1
;IF NO.IO.LIST = 1
@BOX 4.1
;IF FMT.TBL^[FMT.TBL^[CUR.FMT+1] => CUR.FMT] = -3 THEN 0 => N FI
@BOX 6.1
; IF CUR.FMT < FPTR
@BOX 7.1
;ENTER.TRAP(6,105)
@BOX 10.1
;CUR.FMT => FPTR
@BOX 8.1
; FIO.END.REC()
@BOX 9.1
EXIT
@BOX 11.1
; O.POS() => S.POS => C.POS => T.POS + REC => E.POS
@BOX 12.1
; ->RTN.PT
@END
@TITLE FTN24.9.4(1,6)
@COL 1S-3T-4R-5R-6C
@COL 7R
@ROW 4-7
@FLOW 1-3N-4-5-6
@FLOW 3YES-7-6
@BOX 1.0
PROC OWRITE : END OF GROUP
@BOX 3.0
END OF LOOP?
@BOX 4.0
INCREMENT COUNT
@BOX 5.0
MOVE BACK
@BOX 6.0
RTN
PT
@BOX 7.0
UNSTACK GRP.CNT
@BOX 1.1
;END.GROUP:
@BOX 3.1
; IF FMT.TBL^[FMT.TBL^[CUR.FMT+1] => T + 1] = GRP.CNT
@BOX 4.1
; 1+> GRP.CNT
@BOX 5.1
; T => CUR.FMT
@BOX 6.1
; -> RTN.PT
@BOX 7.1
; FMT.STACK[1->FMT.NEST] => GRP.CNT
@END
@TITLE FTN24.9.6(1,11)
@COL 1S-2T-3C
@COL 4F
@ROW 3-4
@FLOW 1-2N-3
@FLOW 2Y-4
@BOX 1.0
0WRITE: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 = 1
@BOX 3.1
; 1 => N
; -> RTN.PT
@BOX 4.1
EXIT
@END
@TITLE FTN24.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.SW:
@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.O.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 FTN24.10(1,6)
@COL 1S-2T-3R-4R-5R-6R-7R-8T-9R-10F
@COL 11T-12C
@ROW 9-11
@FLOW 1-2N-3-4-5-6-7-8N-9-10
@FLOW 2Y-4
@FLOW 8Y-11N-12
@FLOW 11Y-10
@BOX 1.0
UNPACK EXP(INT,E)WIDTH
@BOX 2.0
E /= 0?
@BOX 3.0
SET E = 2
@BOX 4.0
SAVE INT SIGN
@BOX 5.0
UNPACK INT
@BOX 6.0
ADD LEADING ZEROES
@BOX 7.0
ADD SIGN
@BOX 8.0
NO OF DIGITS > E
@BOX 9.0
ADD E
@BOX 10.0
RETURN
WIDTH
@BOX 11.0
E ON ENTRY = 0
AND E HAS 3 DIGITS
@BOX 12.0
RETURN
E TOO SMALL
@BOX 1.1
;PROC FIO.UNPACK.EXP(INT,E)
;INTEGER OLD.E,SIGN,I
@BOX 2.1
;IF E => OLD.E /= 0
@BOX 3.1
; 2 => E
@BOX 4.1
;IF INT >= 0 THEN
    '+ => SIGN
ELSE
    '- => SIGN
    ;0 -:> INT
FI
@BOX 5.1
;0 => I
;WHILE INT /= 0 DO
   INT - (10 /> INT * 10)+'0 => DIGITS[63-I]
  ; 1 +> I
OD
@BOX 6.1
;WHILE I < E DO
    '0 => DIGITS[63-I]
    ;1 +> I
OD
@BOX 7.1
;SIGN => DIGITS[63-I]
@BOX 8.1
;IF I > E
@BOX 9.1
; 'E => DIGITS[62-I]
@BOX 10.1
; 2+E => FIO.UNPACK.EXP
END
@BOX 11.1
;IF OLD.E = 0 AND I = 3
@BOX 12.1
; -1 => FIO.UNPACK.EXP
EXIT
@END
@TITLE FTN24.13(1,6)
@COL 1S-5R-6T-7R-8T-9T-10R
@COL 11R-12N-13C
@COL 19R-20T-21R-22T-23T-24R-25R-26F
@COL 27T-28R
@ROW 5-19
@ROW 21-27
@ROW 7-11
@ROW 8-12
@ROW 10-13
@FLOW 1-5-6NO-7-8NO-9NO-10-8YES-12-19
@FLOW 6YES-11-8
@FLOW 9YES-13
@FLOW 19-20N-21-22N-23N-24-25-26
@FLOW 20Y-27N-22Y-26
@FLOW 27Y-28-22
@FLOW 23YES-25
@BOX 50.0
FTN24.13
@BOX 1.0
PROC WRITE LAYOUT
@BOX 5.0
SET NUMBER CHARS
SIGN+FRAC.DIG+POINT+PS
@BOX 6.0
INTEGER
PART?
@BOX 7.0
CHARS + 1
OPT 0
@BOX 8.0
CHARS LE W?
@BOX 9.0
NO OPT 0
@BOX 10.0
CHARS - 1
NO ZERO CHAR
@BOX 11.0
CHARS + INT
@BOX 13.0
END
@BOX 19.0
SPACES
@BOX 20.0
NO SIGN
@BOX 21.0
'-' SIGN
@BOX 22.0
INT?
@BOX 23.0
NO OPT 0?
@BOX 24.0
CHAR ZERO
@BOX 25.0
CHAR DP
@BOX 26.0
FINISH
@BOX 27.0
PS=1?
@BOX 28.0
'+' SIGN
@BOX 1.1
;PROC FIO.WRITE.LAYOUT(W,D,SIGN,INT)
;INTEGER CHARS,OPT
@BOX 5.1
;SIGN!POS.S + D+1 => CHARS
; 0 => OPT
@BOX 6.1
;IF INT > 0
@BOX 7.1
; 1 +> CHARS
; 1 => OPT
@BOX 8.1
;IF CHARS =< W
@BOX 9.1
;IF OPT = 0
@BOX 10.1
;1 -> CHARS
;0 => OPT
@BOX 11.1
;INT +> CHARS
@BOX 13.1
;1 => FIO.WRITE.LAYOUT
EXIT
@BOX 19.1
;SPACES(W-CHARS)
@BOX 20.1
;IF SIGN = 0
@BOX 21.1
;OUT.CH('-)
@BOX 22.1
;IF INT > 0
@BOX 23.1
;IF OPT = 0
@BOX 24.1
;OUT.CH('0)
@BOX 25.1
;OUT.CH('.)
@BOX 26.1
;0 => FIO.WRITE.LAYOUT
END
@BOX 27.1
;IF POS.S = 0
@BOX 28.1
;OUT.CH('+)
@END
@TITLE FTN24.14(1,11)
@COL 11R-12R
@COL 1S-17T-18R-2T-3T-4T-5T-6R-8R-9F
@COL 13R-14R-15R-16R
@ROW 11-5
@ROW 3-13
@FLOW 1-17N-18-2N-3N-4N-5N-6-8-9
@FLOW 2Y-13
@FLOW 3Y-14-15-9
@FLOW 4Y-11-12-8
@FLOW 5Y-16-8
@FLOW 17Y-2
@BOX 1.0
PROC FIO.END.REC
@BOX 2.0
RECORD TOO LONG
@BOX 3.0
INTERNAL FILE
@BOX 4.0
DIRECT ACCESS
@BOX 5.0
UNFORMATTED
@BOX 6.0
OUTPUT RECORD TERMINATOR (NL)
SET END POSITION
@BOX 8.0
NOTE UNIT ACCESSED
@BOX 9.0
END
@BOX 11.0
BLANK FILL RECORD
@BOX 12.0
SET NEXT RECORD NO
UPDATE MAX POSITION IN UNIT IF NECESSARY
@BOX 13.0
FAULT
@BOX 14.0
BLANK FILL RECORD
@BOX 15.0
END MUSS RECORD
@BOX 16.0
END MUSS RECORD
SET END POSITION
@BOX 17.0
FORMATTED OR
LIST DIRECTED
@BOX 18.0
NOTE END POSITION
@BOX 1.1
;PROC FIO.END.REC
;$IN32 POS,L
@BOX 2.1
;IF E.POS-C.POS => L < 0
@BOX 3.1
;IF CUR.UNIT = NIL
@BOX 4.1
;IF STATUS OF CUR.UNIT^ & 2 /= 0
@BOX 5.1
;IF CUR.FMT = -1
@BOX 6.1
;NEWLINES(1)
;O.POS() => MAX.POS OF CUR.UNIT^
@BOX 8.1
;1 !> STATUS OF CUR.UNIT^
@BOX 9.1
;END
@BOX 11.1
;SPACES(L)
@BOX 12.1
;1 +> RECORD.NO OF CUR.UNIT^
;IF O.POS() => POS > MAX.POS OF CUR.UNIT^ THEN
   ;POS => MAX.POS OF CUR.UNIT^
;FI
@BOX 13.1
;ENTER.TRAP(6,116)
@BOX 14.1
;SPACES(L)
@BOX 15.1
;OUT.REC()
@BOX 16.1
;OUT.REC()
;O.REC() => MAX.RECORD.POS OF CUR.UNIT^
;0 => MAX.POS OF CUR.UNIT^
@BOX 17.1
;IF CUR.FMT /= -1
@BOX 18.1
;O.POS() => C.POS
@END

@TITLE FTN24.15(1,11)
@COL 1S-4R-5F
@FLOW 1-4-5
@BOX 1.0
OUT.CHARS(CHAR,N)
@BOX 4.0
OUTSYM N
CHARS
@BOX 5.0
END
@BOX 1.1
;PROC FIO.OUT.CHARS(CHAR,N)
@BOX 4.1
;FOR N DO OUTCH(CHAR)OD
@BOX 5.1
END
@END
^L@TITLE FTN24.16(1,11)
@COL 1S-6T-7R-2R-3R-4R-5F
@FLOW 1-6N-7-2-3-4-5
@FLOW 6Y-2
@BOX 1.0
FIO.WRITE.HOLL(HOLL,STORAGE)
@BOX 2.0
ASSIGN HOLL TO THE RIGHT
VARIABLE(I64,I32,I16,I8)
DEPENDING ON STORAGE SIZE
@BOX 3.0
IF STORAGE < WIDTH THEN
WRITE (WIDTH -STORAGE)
SPACES
@BOX 4.0
FOR I < STORAGE
WRITE CHARS FROM
HOLL.ARRAY
@BOX 5.0
END
@BOX 6.0
PICK UP WIDTH
NOT ZERO
@BOX 7.0
SET WIDTH FROM STORAGE
@BOX 1.1
;PROC FIO.WRITE.HOLL(HOLL,STORAGE)
;$IN I,WIDTH
@BOX 2.1
;IF STORAGE = I64.SIZE.L THEN
HOLL => I64
ELSE
IF STORAGE = I32.SIZE.L THEN
HOLL => I32
ELSE
IF STORAGE = I16.SIZE.L THEN
HOLL => I16
ELSE
HOLL => I8 FI FI FI
@BOX 3.1
;SPACES(WIDTH-STORAGE)
@BOX 4.1
;FOR I < WIDTH DO
     OUT.CH(HOLL.ARRAY[I])
     OD
@BOX 5.1
;END
@BOX 6.1
;IF FMT.TBL^[CUR.FMT+1] => WIDTH /= 0
@BOX 7.1
;STORAGE => WIDTH
@END
@TITLE FTN24.17(1,11)
@COL 1S-2T-3R-4F
@COL 5R-6R
@ROW 3-5
@FLOW 1-2N-3-4
@FLOW 2Y-5-6-4
@BOX 1.0
PROC FIO.SEL.FLD(WIDTH)
@BOX 2.0
CURRENT REC POSITION
BEYOND TIDEMARK
@BOX 3.0
UPDATE CUR REC POSITION
UPDATE TIDEMARK IF NECESSARY
@BOX 4.0
END
@BOX 5.0
OUTPUT BLANKS FROM
TIDEMARK TO CUR REC POSITION
@BOX 6.0
UPDATE CUR AND TIDEMARK REC
POSITIONS
@BOX 1.1
;PROC FIO.SEL.FLD(W)
@BOX 2.1
;IF C.POS > T.POS
@BOX 3.1
;IF W +> C.POS > T.POS THEN
   ;C.POS => T.POS
;FI
@BOX 4.1
;END
@BOX 5.1
;SPACES(C.POS - T.POS)
@BOX 6.1
;W +> C.POS => T.POS
@END
@TITLE FTN24.20(1,11)
@COL 1S-2R-3R-4R-5R-6F
@FLOW 1-2-3-4-5-6
@BOX 1.0
FIO.LD.I.WRITE(INT)
@BOX 2.0
CALCULATE WIDTH
@BOX 3.0
SET UP
FORMAT ENTRY
@BOX 4.0
OUTPUT SEPARATOR
:4.26
@BOX 5.0
OUTPUT I UNDER
FORMAT CONTROL
:4.40
@BOX 6.0
END
@BOX 1.1
;PROC FIO.LD.I.WRITE(INT)
;$IN32 I, J
;INTEGER WIDTH
@BOX 2.1
;IF INT => I > 0 THEN 0-:> I FI
;2 => WIDTH
;I => J
;WHILE J =< -10 DO
   1+>WIDTH; 10/>J OD
@BOX 3.1
;1 => R.FMT.TBL[0]
;WIDTH => R.FMT.TBL[1]
;1 => R.FMT.TBL[2]
;0 => CUR.FMT
; ^R.FMT.TBL => FMT.TBL
@BOX 4.1
;FIO.OUT.SEPARATOR(WIDTH)
@BOX 5.1
;FIO.WRITE.INTEGER(INT)
; ^LD.FMT.TBL => FMT.TBL
; -2 => CUR.FMT
@BOX 6.1
END
@END
@TITLE FTN24.20.1(1,11)
@COL 1S-2R-6F
@FLOW 1-2-6
@BOX 1.0
LD.I8.WRITE(INT)
@BOX 2.0
LD.I16.WRITE(INT)
@BOX 6.0
END
@BOX 1.1
;PROC FIO.LD.I8.WRITE(INT)
@BOX 2.1
;FIO.LD.I16.WRITE(INT)
@BOX 6.1
END
@END
@TITLE FTN24.20.2(1,11)
@COL 1S-2R-3R-4R-5R-6F
@FLOW 1-2-3-4-5-6
@BOX 1.0
LD.I16.WRITE(INT)
@BOX 2.0
CALCULATE WIDTH
@BOX 3.0
SET UP
FORMAT ENTRY
@BOX 4.0
OUTPUT SEPARATOR
:4.26
@BOX 5.0
OUTPUT I UNDER
FORMAT CONTROL
:4.40
@BOX 6.0
END
@BOX 1.1
;PROC FIO.LD.I16.WRITE(INT)
;INTEGER I,J,WIDTH
@BOX 2.1
;IF INT => I > 0 THEN 0-:> I FI
;2 => WIDTH
;I => J
;WHILE J =< -10 DO
   1+>WIDTH; 10/>J OD
@BOX 3.1
;1 => R.FMT.TBL[0]
;WIDTH => R.FMT.TBL[1]
;1 => R.FMT.TBL[2]
;0 => CUR.FMT
; ^R.FMT.TBL => FMT.TBL
@BOX 4.1
;FIO.OUT.SEPARATOR(WIDTH)
@BOX 5.1
;FIO.WRITE.INTEGER(INT)
; ^LD.FMT.TBL => FMT.TBL
; -2 => CUR.FMT
@BOX 6.1
END
@END
@TITLE FTN24.20.3(1,11)
@COL 1S-2R-6F
@FLOW 1-2-6
@BOX 1.0
LD.I32.WRITE(INT)
@BOX 2.0
LD.I.WRITE(INT)
@BOX 6.0
END
@BOX 1.1
;PROC FIO.LD.I32.WRITE(INT)
@BOX 2.1
;FIO.LD.I.WRITE(INT)
@BOX 6.1
END
@END
@TITLE FTN24.21(1,6)
@COL 1S-3R-4R-9R-5R-6F
@FLOW 1-3-4-9-5-6
@BOX 1.0
LD.R.WRITE(REAL)
@BOX 3.0
SET SCALE
=1
@BOX 4.0
SET FORMAT TO
G15.8
@BOX 5.0
OUT PUT REAL
UNDER FORMAT
CONTROL:4.41
RESET SCALE
@BOX 9.0
OUTPUT
SEPARATOR:4.26
@BOX 6.0
END
@BOX 1.1
;PROC FIO.LD.R.WRITE(REAL.X)
;$RE32 X
;INTEGER WIDTH
@BOX 3.1
;1 => SCF
@BOX 4.1
;FMT.G15.8L => CUR.FMT
@BOX 9.1
;FIO.OUT.SEPARATOR(15)
@BOX 5.1
;FIO.WRITE.REAL(REAL.X)
;0 => SC.F
; -2 => CUR.FMT
@BOX 6.1
END
@END
@TITLE FTN24.22(1,6)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
LD.DP.WRITE(DP)
@BOX 2.0
LD.R.WRITE(DP
CONVERTED TO REAL)
@BOX 3.0
END
@BOX 1.1
;PROC FIO.LD.DP.WRITE(DP)
@BOX 2.1
;FIO.LD.R.WRITE(DP)
@BOX 3.1
END
@END
@TITLE FTN24.23(1,11)
@COL 1S-3R-4R-5R-6R-7R-8R-9R-10F
@FLOW 1-3-4-5-6-7-8-9-10
@BOX 1.0
LD.C.WRITE(COMPLEX)
@BOX 3.0
OUTPUT SEPARATOR
@BOX 4.0
PRINT(
@BOX 5.0
SET SCALE=1
SET POS SIGN
SET FORMAT=E13.6E4
@BOX 6.0
OUTPUT REAL PART
UNDER FORMAT CONTROL
:4.3.1
@BOX 7.0
PRINT ','
@BOX 8.0
OUTPUT IMAG.PART
UNDER FORMAT CONTROL
:4.41
@BOX 9.0
INH POS SIGN
PRINT ')'
@BOX 10.0
END
@BOX 1.1
;PROC FIO.LD.C.WRITE(COMPL)
@BOX 3.1
;FIO.OUT.SEPARATOR(33)
@BOX 4.1
;OUTCH('()
;1 +> C.POS => T.POS
@BOX 5.1
;FMT.E15.6E4L => CUR.FMT
;1 => SCF => POS.S
@BOX 6.1
;FIO.WRITE.REAL(R OF COMPL^)
@BOX 7.1
;OUTCH(',)
;1 +> C.POS => T.POS
@BOX 8.1
;FMT.E15.6E4L => CUR.FMT
;FIO.WRITE.REAL(I OF COMPL^)
@BOX 9.1
;0 => POS.S
;1 +> C.POS => T.POS
;OUTCH('))
; -2 => CUR.FMT
@BOX 10.1
END
@END
@TITLE FTN24.24(1,11)
@COL 1S-2R-5F
@FLOW 1-2-5
@BOX 1.0
FIO.LD.L.WRITE(L)
@BOX 2.0
FIO.LD.L8.WRITE(L)
@BOX 5.0
END
@BOX 1.1
;PROC FIO.LD.L.WRITE(LOG)
@BOX 2.1
;FIO.LD.L8.WRITE(LOG)
@BOX 5.1
END
@END
@TITLE FTN24.24.1(1,11)
@COL 1S-2R-3T-4R-5F
@COL 6R
@ROW 4-6
@FLOW 1-2-3N-4-5
@FLOW 3Y-6-5
@BOX 1.0
LD.L8.WRITE(L)
@BOX 2.0
OUTPUT SEPARATOR
:4.26
@BOX 3.0
TRUE?
@BOX 4.0
OUTPUT 'F'
@BOX 5.0
END
@BOX 6.0
OUTPUT 'T'
@BOX 1.1
;PROC FIO.LD.L8.WRITE(LOG)
@BOX 2.1
;FIO.OUT.SEPARATOR(1)
@BOX 3.1
;IF LOG = TRUE.L
@BOX 4.1
;OUTCH('F)
@BOX 6.1
;OUTCH('T)
@BOX 5.1
END
@END
@TITLE FTN24.24.2(1,11)
@COL 1S-2R-5F
@FLOW 1-2-5
@BOX 1.0
LD.L16.WRITE(L)
@BOX 2.0
LD.L8.WRITE(L)
@BOX 5.0
END
@BOX 1.1
;PROC FIO.LD.L16.WRITE(LOG)
@BOX 2.1
;FIO.LD.L8.WRITE(LOG)
@BOX 5.1
END
@END
@TITLE FTN24.24.3(1,11)
@COL 1S-2R-5F
@FLOW 1-2-5
@BOX 1.0
LD.L32.WRITE(L)
@BOX 2.0
LD.L8.WRITE(L)
@BOX 5.0
END
@BOX 6.0
OUTPUT 'T'
@BOX 1.1
;PROC FIO.LD.L32.WRITE(LOG)
@BOX 2.1
;FIO.LD.L8.WRITE(LOG)
@BOX 5.1
END
@END
@TITLE FTN24.25(1,11)
@COL 1S-2T-3T-4R-5R-6T-7R-8R-9R-10R-11F
@FLOW 1-2N-3N-4-5-6N-7-8-9-10-11
@FLOW 2Y-5-6Y-8
@FLOW 3Y-5
@BOX 1.0
LD.STR.WRITE(STR)
@BOX 2.0
ENOUGH ROOM ON
LINE FOR STR?
@BOX 3.0
START OF
LINE?
@BOX 4.0
END RECORD
SET UP NEXT RECORD
@BOX 5.0
FOR NO OF CHARS
IN STRING
@BOX 6.0
NOT END OF
LINE?
@BOX 7.0
END RECORD
SET UP NEXT RECORD
@BOX 8.0
OUTPUT CHAR
@BOX 9.0
REPEAT
@BOX 10.0
SET LAST ITEM
STRING FLAG
@BOX 11.0
END
@BOX 1.1
;PROC FIO.LD.STR.WRITE(STRING)
;INTEGER J,I
;SIZE(STRING) => I
@BOX 2.1
;IF C.POS + I =< E.POS
@BOX 3.1
;IF C.POS = S.POS
@BOX 4.1
;FIO.END.REC()
;O.POS() => S.POS => C.POS + REC => E.POS
@BOX 5.1
;I-1 => J
;WHILE 1->I >=0 DO
@BOX 6.1
;IF C.POS < E.POS
@BOX 7.1
;FIO.END.REC()
;O.POS() => S.POS => C.POS + REC => E.POS
@BOX 8.1
;OUTCH(STRING^[J-I])
;1 +> C.POS
@BOX 9.1
OD
@BOX 10.1
;1 => LAST.ITEM
;C.POS => T.POS
@BOX 11.1
END
@END
@TITLE FTN24.26(1,11)
@COL 1S-2T-3R-10N-4F
@COL 5T-6R
@COL 7R
@ROW 3-5
@ROW 6-7
@FLOW 1-2N-3-10-4
@FLOW 2Y-5N-6-4
@FLOW 5Y-7-4
@BOX 1.0
OUT.SEPARATOR(WIDTH)
@BOX 2.0
UPDATE RECORD
CH COUNT
ENOUGH ROOM
FOR ITEM?
@BOX 3.0
END RECORD
SET UP NEXT RECORD
@BOX 4.0
END
@BOX 5.0
LAST ITEM
READ STRING?
@BOX 6.0
OUTPUT
SPACE
UPDATE RECORD POSITION
@BOX 7.0
RESET LAST
ITEM FLAG
@BOX 1.1
;PROC FIO.OUT.SEPARATOR(WIDTH)
@BOX 2.1
;IF 1-LAST.ITEM + C.POS + WIDTH =< E.POS
@BOX 3.1
;FIO.END.REC()
;O.POS() => S.POS => C.POS => T.POS + REC => E.POS
@BOX 4.1
END
@BOX 5.1
;IF LAST.ITEM /= 0
@BOX 6.1
;OUTCH(SPACE.L)
;1 +> C.POS => T.POS
@BOX 7.1
;0 => LAST.ITEM
@END
@TITLE FTN24.30(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
UF.I32.WRITE
@BOX 2.0
OUTPUT INTEGER
BYTE AT A TIME
@BOX 3.0
END
@BOX 1.1
; PROC FIO.UF.I32.WRITE(INT)
@BOX 2.1
; OUT.BIN(INT, 4)
@BOX 3.1
END
@END
@TITLE FTN24.30.1(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
UF.I16.WRITE
@BOX 2.0
OUTPUT INTEGER
@BOX 3.0
END
@BOX 1.1
; PROC FIO.UF.I16.WRITE(INT)
@BOX 2.1
; OUT.BIN(INT, 2)
@BOX 3.1
END
@END
^L@TITLE FTN24.30.2(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
UF.I8.WRITE
@BOX 2.0
OUTPUT INTEGER
@BOX 3.0
END
@BOX 1.1
; PROC FIO.UF.I8.WRITE(INT)
@BOX 2.1
; OUT.CH(INT)
@BOX 3.1
; END
@END
@TITLE FTN24.31(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
UF.R.WRITE
@BOX 2.0
OUTPUT REAL
@BOX 3.0
END
@BOX 1.1
; PROC FIO.UF.R.WRITE(X)
; $LO32 ANS
@BOX 2.1
; OUT.BIN(X => ANS, 4)
@BOX 3.1
END
@END
@TITLE FTN24.32(1,6)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
UF.DP.WRITE
@BOX 2.0
OUTPUT DP
@BOX 3.0
END
@BOX 1.1
;PROC FIO.UF.DP.WRITE(DP)
;TYPE CONV IS $RE32 A, B OR $RE64 X
;CONV DBL
@BOX 2.1
;DP => X OF DBL
;FIO.UF.R.WRITE(A OF DBL)
;FIO.UF.R.WRITE(B OF DBL)
@BOX 3.1
END
@END
@TITLE FTN24.33(1,6)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
UF.C.WRITE
@BOX 2.0
OUTPUT COMPLEX
@BOX 3.0
END
@BOX 1.1
;PROC FIO.UF.C.WRITE(COMPL)
@BOX 2.1
;FIO.UF.R.WRITE(R OF COMPL^)
;FIO.UF.R.WRITE(I OF COMPL^)
@BOX 3.1
END
@END

@TITLE FTN24.34(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
UF.L32.WRITE
@BOX 2.0
OUTPUT LOGICAL
@BOX 3.0
END
@BOX 1.1
; PROC FIO.UF.L32.WRITE(LOG)
@BOX 2.1
; OUT.BIN(LOG, 4)
@BOX 3.1
END
@END
@TITLE FTN24.34.1(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
UF.L16.WRITE
@BOX 2.0
OUTPUT LOGICAL
@BOX 3.0
END
@BOX 1.1
; PROC FIO.UF.L16.WRITE(LOG)
@BOX 2.1
; OUT.BIN(LOG, 2)
@BOX 3.1
END
@END
^L@TITLE FTN24.34.2(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
UF.L8.WRITE
@BOX 2.0
OUTPUT CHAR
@BOX 3.0
END
@BOX 1.1
; PROC FIO.UF.L8.WRITE(LOG)
@BOX 2.1
; OUT.CH(LOG)
@BOX 3.1
;END
@END
@TITLE FTN24.35(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
UF.STR.WRITE
@BOX 2.0
OUTPUT STRING
@BOX 3.0
END
@BOX 1.1
; PROC FIO.UF.STR.WRITE(STRING)
@BOX 2.1
;CAPTION (STRING)
@BOX 3.1
END
@END
@TITLE FTN24.40(1,11)
@COL 15R
@COL 1S-2R-3T-4R-5R-7T-6R-8T-9R-10R
@COL 11T-13R-14R-18T-19R-20R-21F
@COL 12R-25C
@ROW 15-4
@ROW 14-12
@FLOW 1-2-3N-4-5-7N-6-7Y-9-10-11N-13-14-18N-19-18Y-20-21
@FLOW 3Y-15-5
@FLOW 11Y-12-25
@BOX 1.0
PROC WRITE.INTEGER(INT)
@BOX 2.0
PICK UP INTEGER
WIDTH AND D
SELECT RECORD FIELD
@BOX 3.0
POS?
@BOX 15.0
SET SIGN CH
IF SP
OPERATIVE
@BOX 4.0
SET SIGN CH
NEGATE
@BOX 5.0
SET PTRS
@BOX 7.0
INT ZERO?
@BOX 6.0
EVAL CHAR
REDUCE INT
@BOX 9.0
EVAL ZEROS
@BOX 10.0
EVAL SPACES
@BOX 11.0
NEG SP?
@BOX 13.0
SPACES
@BOX 14.0
OUTPUT SIGN IF
REQUIRED
@BOX 18.0
ZEROES?
@BOX 19.0
CHAR 0
@BOX 20.0
OUTPUT INT
@BOX 21.0
FINISH
@BOX 12.0
OUTPUT
ASTERISKS
@BOX 25.0
END
@BOX 1.1
;PROC FIO.WRITE.INTEGER(INT)
;$IN32 N
;INTEGER SIGN,WIDTH,D,PTR,ZEROES,SP,CHAR,SIGN.CH,I
;0 => ZEROES
@BOX 2.1
;INT => N
;FIO.SEL.FLD(FMT.TBL^[CUR.FMT+1] => WIDTH)
;FMT.TBL^[CUR.FMT+2] => D
@BOX 3.1
;IF N >= 0
@BOX 15.1
;0-:>N
;IF POS.S => SIGN /=0 THEN '+ => SIGN.CH FI
@BOX 4.1
::CV ;0-:>N
;'- => SIGN.CH
;1 => SIGN
@BOX 5.1
;63 => PTR
@BOX 7.1
;IF N=0
@BOX 6.1
;N-:(10/>N*10)+'0 => DIGITS[PTR]
;1 -> PTR
@BOX 9.1
;D-63+PTR => ZEROES
@BOX 10.1
;WIDTH-63+PTR-SIGN=>SP
;IF ZEROES > 0 THEN ZEROES -> SP FI
@BOX 11.1
;IF SP < 0
@BOX 13.1
;SPACES(SP)
@BOX 14.1
;IF SIGN=1 THEN OUT.CH(SIGN.CH) FI
@BOX 18.1
;IF ZEROES =< 0
@BOX 19.1
;OUT.CH('0)
;1 -> ZEROES
@BOX 20.1
; IF 1 +> PTR < 64 THEN OUT.CH(DIGITS[PTR]) FI
;WHILE 1 +> PTR < 64 DO OUTCH(DIGITS[PTR]) OD
@BOX 21.1
END
@BOX 12.1
;FIO.OUT.CHARS('*,WIDTH)
@BOX 25.1
EXIT
@END
@TITLE FTN24.41(1,11)
@COL 1S-3R-4R-5R-6T-7T-2T-8R-9T-21T-22R
@COL 19R-35C-26T-27R-28R-10R
@COL 20R-11R-12T-13R-14T-15T-17R-18F
@COL 23R-24R-25C
@ROW 7-20
@ROW 13-23
@ROW 19-15
@ROW 22-26-17
@FLOW 1-3-4-5-6N-7N-2N-8-9N-21N-22-9Y-26N-27-10-11-12N-13-14N-15N-17-18
@FLOW 6Y-20-11-12Y-23-14Y-24-25
@FLOW 7Y-19-35
@FLOW 21Y-19
@FLOW 26Y-28-10
@FLOW 15Y-18
@FLOW 2Y-11
@BOX 1.0
PROC WRITE.REAL(REAL)
@BOX 2.0
ZERO?
@BOX 3.0
PICK UP CONST
@BOX 4.0
REMOVE SIGN
@BOX 5.0
PICK UP WDE
SELECT OUTPUT FIELD
@BOX 6.0
F?
@BOX 7.0
E OR D?
@BOX 8.0
SET RANGE
@BOX 9.0
IN RANGE?
@BOX 21.0
END OF F
RANGE?
@BOX 22.0
NEXT RANGE
@BOX 19.0
E OR D FORMAT:4.41.1
@BOX 10.0
SET D
@BOX 20.0
SCALE
@BOX 11.0
ROUND
@BOX 12.0
ZERO?
@BOX 13.0
NORMALISE :4.41.3:
@BOX 23.0
SET EXP
@BOX 14.0
WRITE CONST :4.41.2:
FAULTY
@BOX 15.0
F ?
@BOX 17.0
SPACES
@BOX 18.0
FINISH
@BOX 24.0
OUTPUT
*'S
@BOX 25.0
END
@BOX 26.0
E=0?
@BOX 27.0
W=W-4
@BOX 28.0
W=W-(E+2)
@BOX 1.1
;PROC FIO.WRITE.REAL(REAL.X)
;$RE32 X,A,B
;INTEGER SIGN,W,D,I,EX,E,FD,SP.CNT,INT,EW
@BOX 3.1
;REAL.X => X
@BOX 4.1
; 0 => SIGN
;IF X <RD0.0 THEN
    RD0.0 -:> X
   ;1 => SIGN
FI
@BOX 5.1
;FIO.SEL.FLD(FMT.TBL^[CUR.FMT+1] => W)
;FMT.TBL^[CUR.FMT+2] => D
;FMT.TBL^[CUR.FMT+3] => E
@BOX 6.1
;IF FMT.TBL^[CUR.FMT] => FD = 5
@BOX 7.1
;  IF FD = 4
@BOX 2.1
; IF X = RD0.0
@BOX 8.1
;RD0.1 => A
;RD1.0 => B
;0 => I
@BOX 9.1
;IF X >= A AND X <B
@BOX 21.1
;IF 1+>I >= D
@BOX 22.1
;B => A*RD10.0 => B
@BOX 19.1
#FTN24.41.1
@BOX 20.1
;IF SCF /= 0 THEN EXP(SCF*RDLOG10.0) *>X FI
@BOX 10.1
;I -> D
@BOX 11.1
;EXP(D*RDLOG0.1)*RD0.5 +> X
@BOX 12.1
; IF X = RD0.0
@BOX 13.1
;FIO.NORMALISE(X) => X
;PW1 => EX
@BOX 14.1
;IF FIO.WRITE.CONST(X,W,D,SIGN,EX) /= 0
@BOX 15.1
;IF FD = 5
@BOX 17.1
;SPACES(SP.CNT)
@BOX 18.1
END
@BOX 23.1
;0 => EX
@BOX 24.1
;FIO.OUT.CHARS('*,W)
@BOX 25.1
EXIT
@BOX 26.1
;IF E = 0
@BOX 27.1
;4 => SP.CNT -> W
@BOX 28.1
E+2 => SP.CNT -> W
@BOX 35.1
EXIT
@END
@TITLE FTN24.41.1(1,6)
@COL 1S-3T-4R-5R-6T-7R-8T-17R-16T-9T-11R-12F
@COL 13R-14T-15R
@ROW 4-13
@ROW 15-9
@ROW 7-14
@FLOW 1-3N-4-5-6N-7-8N-17-16N-9N-11-12
@FLOW 3YES-13-5
@FLOW 6YES-14NO-15-12
@FLOW 9Y-15
@FLOW 8YES-15
@FLOW 14YES-17
@FLOW 16Y-15
@BOX 1.0
PROC RWRITE:D OR E FORMAT
@BOX 3.0
ZERO ?
@BOX 4.0
NORMALISE :4.41.3:
@BOX 5.0
SCALE
@BOX 6.0
SCALE LE 0?
@BOX 7.0
D - SF + 1
@BOX 8.0
D LT 0
@BOX 17.0
ROUND TO
D DECIMALS
@BOX 16.0
UNPACK EXP:4.10
FAULTY
@BOX 9.0
WRITE CONST :4.41.2:
FAULTY?
@BOX 10.0
END OF RECORD?
@BOX 11.0
WRITE EXP
@BOX 12.0
FINISH
@BOX 13.0
SET EXP
@BOX 14.0
D + SCALE
GT 0?
@BOX 15.0
OUTPUT ASTERISKS
@BOX 1.1
@BOX 3.1
;IF X = RD0.0
@BOX 4.1
;FIO.NORMALISE(X) => X
;PW1 => EX
@BOX 5.1
;SCF => INT
@BOX 6.1
;IF INT =< 0
@BOX 7.1
;1 - INT +> D
@BOX 8.1
;IF D < 0
@BOX 17.1
; 0 -D-INT=>I
;EXP(I*RDLOG10.0)*RD0.5+>X
;IF X >= RD1.0 THEN
    RD10.0 /> X
   ; 1+> EX
FI
@BOX 16.1
;IF FIO.UNPACK.EXP(EX-INT,E) => EW < 0
@BOX 9.1
;IF FIO.WRITE.CONST(X,W-EW,D,SIGN,INT) /= 0
@BOX 11.1
;WHILE 1->EW >=0 DO OUTCH(DIGITS[63-EW]) OD
@BOX 13.1
; 0 => EX
@BOX 14.1
;IF D+INT > 0
@BOX 15.1
;FIO.OUTCHARS('*,W)
@BOX 12.1
@END
@TITLE FTN24.41.2(1,6)
@COL 1S-5T-6T-7R-8T-9R-10T-11R
@COL 16C-12T-13R-15T-14F
@ROW 12-9
@ROW 6-16
@FLOW 1-5N-6NO-7-8NO-9-10NO-11-10YES-14
@FLOW 6YES-12NO-13-15NO-14
@FLOW 8YES-7
@FLOW 5Y-16
@FLOW 12YES-10
@FLOW 15YES-12
@BOX 1.0
PROC WRITE CONST
@BOX 5.0
WRITE LAYOUT
FAULTY?
@BOX 6.0
NO INT PT?
@BOX 7.0
EVAL CHARS
@BOX 8.0
MORE
INT PT?
@BOX 9.0
CHAR POINT
@BOX 10.0
NO MORE
FRAC PT?
@BOX 11.0
EVAL CHAR
@BOX 12.0
NO FILLING
ZEROES?
@BOX 13.0
CHAR ZERO
@BOX 15.0
MORE FRAC?
@BOX 14.0
FINISH
@BOX 16.0
END
@BOX 1.1
;PROC FIO.WRITE.CONST(X,W,D,SIGN,EXP)
;INTEGER DIG
@BOX 5.1
;IF FIO.WRITE.LAYOUT(W,D,SIGN,EXP) /= 0
@BOX 6.1
;IF EXP =< 0
@BOX 7.1
;RD10.0 *>X => DIG -> X
;OUT.CH(DIG+'0)
;1 -> EXP
@BOX 8.1
;IF EXP /= 0
@BOX 9.1
;OUTCH('.)
@BOX 10.1
;IF D = 0
@BOX 11.1
; RD10.0 *>X => DIG -> X
; 1 -> D
; OUTCH(DIG + '0)
@BOX 12.1
;IF EXP = 0
@BOX 13.1
; 1 +> EXP
; OUTCH('0)
@BOX 15.1
; IF 1 -> D /= 0
@BOX 16.1
; 1 => FIO.WRITE.CONST
EXIT
@BOX 14.1
0 => FIO.WRITE.CONST
END
@END
@TITLE FTN24.41.3(1,6)
@COL 1S-5R-6T-7R
@COL 8T-9R
@COL 10F
@ROW 7-8
@ROW 9-10
@FLOW 1-5-6NO-7-6YES-8NO-9-8YES-10
@BOX 1.0
PROC NORMALISE
@BOX 5.0
ZERO EXP
@BOX 6.0
X LT 1.0?
@BOX 7.0
X * 0.1
EXP + 1
@BOX 8.0
X GE 0.1 ?
@BOX 9.0
X * 10.0
EXP - 1
@BOX 10.0
FINISH
@BOX 1.1
;PROC FIO.NORMALISE(X)
;INTEGER EXP
@BOX 5.1
; 0 => EXP
@BOX 6.1
; IF X <RD1.0
@BOX 7.1
; RD10.0 /> X :: @@@ BCT 08/13/82
; 1 +> EXP
@BOX 8.1
;IF X >= RD0.1
@BOX 9.1
; RD10.0 *> X
; 1 -> EXP
@BOX 10.1
; EXP => PW1
; X => FIO.NORMALISE
END
@END
@TITLE FTN24.42(1,11)
@COL 1S-3R-4R-5R-6T-7T-8R-9T-21T-22R
@COL 36N-19R-35C-26T-27R-28R-10R
@COL 20R-11R-12T-13R-14T-15T-40N-41N-17R-18F
@COL 23R-24R-25C
@ROW 22-26
@ROW 25-19
@ROW 36-6
@ROW 7-20
@ROW 13-23
@FLOW 1-3-4-5-6N-7N-8-9N-21N-22-9
@FLOW 6Y-36-20-11-12N-13-14N-15N-40-41-17-18
@FLOW 7Y-19-35
@FLOW 9Y-26Y-27-10
@FLOW 26N-28-10-11-12Y-23-14-15Y-18
@FLOW 14Y-24-25
@FLOW 21Y-19
@BOX 1.0
PROC WRITE.DP.REAL(DP)
@BOX 3.0
PICK UP CONST
@BOX 4.0
REMOVE SIGN
@BOX 5.0
PICK UP WDE
SELECT RECORD FIELD
@BOX 6.0
F?
@BOX 7.0
D OR E ?
@BOX 35.0
END
@BOX 8.0
SET RANGE
@BOX 9.0
IN RANGE?
@BOX 21.0
END OF F
RANGE?
@BOX 22.0
NEXT RANGE
@BOX 45.0
END
@BOX 19.0
E OR D FORMAT
:24.42.1
@BOX 20.0
SCALE
@BOX 10.0
SET D
@BOX 11.0
ROUND
@BOX 12.0
ZERO?
@BOX 13.0
NORMALISE:
12.4.42.3
@BOX 14.0
WRITE CONST:
12.4.42.2
FAULTY
@BOX 15.0
F?
@BOX 16.0
END OF RECORD?
@BOX 17.0
SPACES
@BOX 24.0
OUTPUT *'S
@BOX 25.0
END
@BOX 23.0
SET EXP
@BOX 26.0
E=0?
@BOX 27.0
W=W-4
@BOX 28.0
W=W-E-2
@BOX 18.0
FINISH
@BOX 1.1
;PROC FIO.WRITE.DP.REAL(DP)
;$IN EX,INT,SIGN,W,D,I
;$IN FD,SP.CNT,E,EW
;$RE64 X,A,B
@BOX 3.1
;DP => X
@BOX 4.1
;0 => SIGN
;IF X < RQ0.0 THEN
   RQ0.0 -:> X
   ;1 => SIGN
FI
@BOX 5.1
;FIO.SEL.FLD(FMT.TBL^[CUR.FMT+1] => W)
;FMT.TBL^[CUR.FMT+2] => D
;FMT.TBL^[CUR.FMT+3] => E
@BOX 6.1
;IF FMT.TBL^[CUR.FMT]
   => FD = 5
@BOX 7.1
;IF FD = 4
@BOX 8.1
;RQ0.1 => A
;RQ1.0 => B
;0 => I
@BOX 9.1
;IF X >= A AND X < B
@BOX 21.1
;IF 1 +> I >= D
@BOX 22.1
;B => A * RQ10.0 => B
@BOX 19.1
#FTN24.42.1
@BOX 20.1
;IF SCF /= 0 THEN
   DEXP(SCF*RQLOG10.0) *> X
FI
@BOX 10.1
;I -> D
@BOX 11.1
;DEXP(D*RQLOG0.1)*RQ0.5 +> X
@BOX 12.1
;IF X = RQ0.0
@BOX 13.1
;FIO.DP.NORMALISE(X) => X
;PW1 => EX
@BOX 14.1
;IF FIO.DP.WRITE.CONST
   (X,W,D,SIGN,EX) /= 0
@BOX 15.1
;IF FD = 5
@BOX 17.1
;SPACES(SP.CNT)
@BOX 23.1
;0 => EX
@BOX 24.1
;FIO.OUT.CHARS('*,W)
@BOX 25.1
EXIT
@BOX 26.1
;IF E = 0
@BOX 27.1
;4 => SP.CNT -> W
@BOX 28.1
;E+2 => SP.CNT -> W
@BOX 35.1
EXIT
@BOX 18.1
END
@END
@TITLE FTN24.42.1(1,6)
@COL 1S-3T-4R-5R-6T-7R-8T-17R-16T-9T-11R-12F
@COL 13R-14T-15R
@ROW 4-13
@ROW 7-14
@ROW 15-9
@FLOW 1-3N-4-5-6N-7-8N-17-16N-9N-11-12
@FLOW 3Y-13-5-6Y-14Y-17
@FLOW 8Y-15-12
@FLOW 14N-15
@FLOW 9Y-15
@FLOW 16Y-15
@BOX 1.0
PROC RWRITE : D ORE FORMAT
@BOX 3.0
ZERO?
@BOX 4.0
NORMALIZE:4.42.3
@BOX 5.0
SCALE
@BOX 6.0
SCALE LE 0?
@BOX 7.0
D-SF+1
@BOX 8.0
D LT 0?
@BOX 17.0
ROUND TO
D DECIMALS
@BOX 16.0
UNPACK EXP:4.10
FAULTY
@BOX 9.0
WRITE CONST:4.42.2
FAULTY?
@BOX 11.0
WRITE EXP
@BOX 13.0
SET EXP
@BOX 14.0
D+SCALE
GT 0?
@BOX 15.0
OUTPUT
ASTERISKS
@BOX 12.0
FINISH
@BOX 1.1
@BOX 3.1
;IF X = RQ0.0
@BOX 4.1
;FIO.DP.NORMALISE(X) => X
;PW1 => EX
@BOX 5.1
;SCF => INT
@BOX 6.1
;IF INT =< 0
@BOX 7.1
;1 - INT +> D
@BOX 8.1
;IF D < 0
@BOX 17.1
;0 - D - INT => I
;DEXP(I * RQLOG10.0) * RQ0.5 +> X
;IF X >= RQ1.0 THEN
   RQ0.1 *> X
   ;1 +> EX
FI
@BOX 16.1
;IF FIO.UNPACK.EXP(EX-INT,E) => EW < 0
@BOX 9.1
;IF FIO.DP.WRITE.CONST(X,W-EW,D,SIGN,INT) -1 = 0
@BOX 11.1
;WHILE 1 -> EW >= 0
   DO OUTCH(DIGITS[63-EW]) OD
@BOX 13.1
;0 => EX
@BOX 14.1
;IF D + INT > 0
@BOX 15.1
;FIO.OUT.CHARS('*,W)
@BOX 12.1
@END
@TITLE FTN24.42.2(1,6)
@COL 1S-5T-6T-7R-8T-9R-10T-11R
@COL 16C-12T-13R-15T-14F
@ROW 6-16
@ROW 9-12
@FLOW 1-5N-6N-7-8N-9-10N-11-10Y-14
@FLOW 5Y-16
@FLOW 6Y-12N-13-15N-14
@FLOW 8Y-7
@FLOW 12Y-10
@FLOW 15Y-12
@BOX 1.0
PROC.DP.WRITE CONSTANT
@BOX 5.0
WRITE LAYOUT
FAULTY?
@BOX 6.0
NO INT PT?
@BOX 7.0
EVAL CHARS
@BOX 8.0
MORE
INT PT?
@BOX 9.0
CHAR POINT
@BOX 10.0
NO MORE
FRAC PT?
@BOX 11.0
EVAL CHAR
@BOX 16.0
END
@BOX 12.0
NO FILLING
ZEROES?
@BOX 13.0
CHAR ZERO
@BOX 15.0
MORE FRAC?
@BOX 14.0
FINISH
@BOX 1.1
;PROC FIO.DP.WRITE.CONST(X,W,D,SIGN,EXP)
;$IN DIG
@BOX 5.1
;IF FIO.WRITE.LAYOUT(W,D,SIGN,EXP) /= 0
@BOX 6.1
;IF EXP =< 0
@BOX 7.1
;RQ10.0 *> X => DIG -> X
;OUT.CH(DIG + '0)
;1 -> EXP
@BOX 8.1
;IF EXP /= 0
@BOX 9.1
;OUTCH('.)
@BOX 10.1
;IF D = 0
@BOX 11.1
;RQ10.0 *> X => DIG -> X
;1 -> D
;OUTCH(DIG + '0)
@BOX 16.1
;1 => FIO.DP.WRITE.CONST
EXIT
@BOX 12.1
;IF EXP = 0
@BOX 13.1
;1 +> EXP
;OUTCH('0)
@BOX 15.1
;IF 1 -> D /= 0
@BOX 14.1
;0 => FIO.DP.WRITE.CONST
END
@END
@TITLE FTN24.42.3(1,6)
@COL 1S-3R-4T-5R
@COL 6T-7R
@COL 8F
@ROW 5-6
@ROW 7-8
@FLOW 1-3-4N-5-4Y-6N-7-6Y-8
@BOX 1.0
PROC DWRITE:NORMALISE
@BOX 3.0
ZERO EXP
@BOX 4.0
X LT 1.0?
@BOX 5.0
X*0.1
EXP+1
@BOX 6.0
XGE0.1?
@BOX 7.0
X*10.0
EXP-1
@BOX 8.0
FINISH
@BOX 1.1
;PROC FIO.DP.NORMALISE(X)
;$IN EXP
@BOX 3.1
;0 => EXP
@BOX 4.1
;IF X < RQ1.0
@BOX 5.1
;RQ0.1 *> X
;1 +> EXP
@BOX 6.1
;IF X >= RQ0.1
@BOX 7.1
;RQ10.0 *> X
;1 -> EXP
@BOX 8.1
;EXP => PW1
;X => FIO.DP.NORMALISE
END
@END

