DIRECTORY
Convert USING [Value, Parse, MapValue],
Ieee USING [SingleReal],
IO USING [bool, char, card, int, real, string, text, time, PutChar, Put, PutF, PutBlock, Close, CreateOutputStreamToRope, CreateOutputStreamToText, GetOutputStreamRope, LookupData, NewLine, StoreData, Signal, PFCodeProc, PFStarCodeProc, STREAM, ROPE, Value, Format],
RefText USING [ObtainScratch, ReleaseScratch],
Real USING [RealException, Fix, MinusZero, PlusZero, MinusInfinity, PlusInfinity],
RealOps USING [RoundC, RoundLI],
Rope USING [Length, Fetch, Lower, Map],
System USING [GreenwichMeanTime]
;


IOPFImpl: CEDAR PROGRAM

IMPORTS Convert, IO, RefText, Real, RealOps, Rope

EXPORTS IO

SHARES IO =

{OPEN IO;


PFStreamData: TYPE = REF PFStreamRecord;
PFStreamRecord: TYPE = RECORD[
procArray: ARRAY CHARACTER ['a..'z] OF PFCodeProc _ ALL[NIL],
starProcArray: ARRAY CHARACTER ['a..'z] OF PFStarCodeProc _ ALL[NIL]
];

prototypePFStreamData: PFStreamData _ NIL;

SetPFCodeProc: PUBLIC PROC [stream: STREAM, char: CHARACTER, codeProc: PFCodeProc] = 
{
IF char IN ['A..'Z] THEN char _ Rope.Lower[char];
IF char NOT IN ['a..'z] THEN Signal[NotImplementedForThisStream, stream]
ELSE {
data: PFStreamData _ GetorCreatePFStreamData[stream];
data.procArray[char] _ codeProc;
};
};

SetPFStarCodeProc: PUBLIC PROC [stream: STREAM, char: CHARACTER, codeProc: PFStarCodeProc] = 
{
IF char IN ['A..'Z] THEN char _ Rope.Lower[char];
IF char NOT IN ['a..'z] THEN Signal[NotImplementedForThisStream, stream]
ELSE {
data: PFStreamData _ GetorCreatePFStreamData[stream];
data.starProcArray[char] _ codeProc;
};
};

GetorCreatePFStreamData: PROC [stream: STREAM] RETURNS [data: PFStreamData] = {
entry: REF ANY _ LookupData[stream, $SetPFCode];
IF entry # NIL THEN data _ NARROW[entry]
ELSE {
data _ NEW[PFStreamRecord _ prototypePFStreamData^];
StoreData[stream, $SetPFCode, data]
};
};

PutF: PUBLIC PROC [stream: STREAM, format: ROPE _ NIL, v1, v2, v3, v4, v5: Value _ [null[]]] = 
{
fp: INT _ 0;
fs: INT _ format.Length[];
IF v1.type#null THEN fp _ PFInternal[stream, format, fp, v1];
IF v2.type#null THEN fp _ PFInternal[stream, format, fp, v2];
IF v3.type#null THEN fp _ PFInternal[stream,  format, fp, v3];
IF v4.type#null THEN fp _ PFInternal[stream, format, fp, v4];
IF v5.type#null THEN fp _ PFInternal[stream,  format, fp, v5];
IF fp < fs THEN [] _ PFInternal[stream, format, fp, [null[]]];
};

GetPFStreamData: PROC [stream: STREAM] RETURNS[pa: PFStreamData] = INLINE
{pa _ NARROW[LookupData[stream, $SetPFCode]];
IF pa = NIL THEN pa _ prototypePFStreamData;
};

PutFL, PutFList: PUBLIC PROC [stream: STREAM, format: ROPE _ NIL, list: LIST OF Value] =
BEGIN
fp: INT _ 0;
fs: INT _ format.Length[];
FOR l: LIST OF READONLY Value _ list, l.rest UNTIL l = NIL
DO fp _ PFInternal[stream, format, fp, l.first];
ENDLOOP;
IF fp < fs THEN [] _ PFInternal[stream, format, fp, [null[]]];
END;   

PFInternal: PROC [stream: STREAM, format: ROPE, formatPtr: INT,
arg: Value] RETURNS [INT] = TRUSTED
{{
formatSize: INT = format.Length[];
savedFormatPointer: INT;
c: CHARACTER _ '#;
GetNextFromFormat: PROC[] = TRUSTED INLINE {
c _ format.Fetch[formatPtr]; formatPtr _ SUCC[formatPtr]; };
IF arg.type=refAny THEN {
pp: REF READONLY ANY _ NARROW[arg, Value[refAny]].value;
arg _ WITH pp SELECT FROM
pi: REF READONLY BOOLEAN => bool[pi^],
pi: REF READONLY CHARACTER => char[pi^],
pi: REF READONLY CARDINAL => card[pi^],
pi: REF READONLY LONG CARDINAL => card[pi^],
pi: REF READONLY INTEGER => int[pi^],
pi: REF READONLY INT => int[pi^],
pi: REF READONLY NAT => int[pi^],
pi: REF READONLY REAL => real[pi^],
pi: REF READONLY TEXT => text[pi],
pi: REF READONLY System.GreenwichMeanTime => time[pi^]
ENDCASE => arg;
};
IF formatSize = 0 THEN {
p: PFCodeProc _ GetPFStreamData[stream].procArray['g];
IF p = NIL THEN { Signal[NotImplementedForThisStream, stream]; GOTO PrintP; }
ELSE { p[stream, arg, [NIL, 0], 'g]; GOTO Quit; };
};
IF formatPtr >= formatSize THEN { Signal[UnknownFormat, stream]; GOTO Quit; };
WHILE formatPtr < formatSize DO {
GetNextFromFormat[];
SELECT c FROM
'% => {
savedFormatPointer _ formatPtr;
DO
IF formatPtr >= formatSize THEN { Signal[UnknownFormat, stream]; GOTO PrintP; };
GetNextFromFormat[];
IF c IN ['a..'z] OR c IN ['A..'Z] OR c = '% THEN EXIT;
ENDLOOP;
IF c = '% THEN stream.PutChar['%] ELSE {
s: STREAM _ stream;
p: PFCodeProc;
IF arg.type=null THEN { Signal[UnknownFormat, stream]; GOTO PrintP; };
IF c IN ['A..'Z] THEN c _ Rope.Lower[c];
DO
pa: PFStreamData _ GetPFStreamData[s];
p _ pa.procArray[c];
IF p # NIL THEN {p[s, arg, [format, savedFormatPointer], c]; EXIT}
ELSE IF s.backingStream # NIL THEN s _ s.backingStream
ELSE {
Signal[NotImplementedForThisStream, stream];
PrintPounds[stream];
EXIT;
};
ENDLOOP;
GOTO Quit;
};
};  --'%
'\\ => {
GetNextFromFormat[];
SELECT c FROM
'N, 'R, 'n, 'r => stream.PutChar[15C];
'B, 'b => stream.PutChar[10C];
'T, 't => stream.PutChar[11C];
'F, 'f => stream.PutChar[14C];
IN ['0..'9] => {  -- octal constant, exactly 3 digits
n: CARDINAL;
IF c NOT IN ['0..'3] THEN GOTO badNum;
n _ (c - '0)*64;
GetNextFromFormat[];
IF c NOT IN ['0..'7] THEN GOTO badNum;
n _ n + (c - '0)*8;
GetNextFromFormat[];
IF c NOT IN ['0..'7] THEN GOTO badNum;
n _ n + (c - '0);
stream.PutChar[LOOPHOLE[n]]};
ENDCASE => stream.PutChar[c];
EXITS
badNum => { Signal[UnknownFormat, stream]; GOTO LoopPrintP; };
};
'* => {
GetNextFromFormat[];
IF c IN ['A..'Z] THEN c _ Rope.Lower[c];
IF c NOT IN ['a..'z] THEN stream.PutChar[c]
ELSE {
sp: PFStarCodeProc;
s: STREAM _ stream;
DO
pa: PFStreamData _ GetPFStreamData[s];
sp _ pa.starProcArray[c];
IF sp # NIL THEN {sp[s, c]; EXIT}
ELSE IF s.backingStream # NIL THEN s _ s.backingStream
ELSE {
Signal[NotImplementedForThisStream, stream];
GOTO LoopPrintP;
};
ENDLOOP;
};
};
ENDCASE => stream.PutChar[c];
EXITS
LoopPrintP => PrintPounds[stream];
};
ENDLOOP;
IF arg.type#null THEN Signal[UnknownFormat, stream];
EXITS
PrintP => PrintPounds[stream];
Quit => NULL;
};
RETURN [formatPtr];
};  --PFInternal

NumRoutine: PFCodeProc = TRUSTED
{
li: INT;
lc: LONG CARDINAL;
r: REF TEXT;
WITH v: val SELECT FROM
boolean => lc _ IF v.value THEN 1 ELSE 0;
character => lc _ LONG[LOOPHOLE[v.value, CARDINAL]];
cardinal => lc _ v.value;
integer => { li _ v.value; lc _ LOOPHOLE[li]; };
real => {
li _ RealOps.RoundLI[v.value ! Real.RealException =>
{ Signal[UnprintableValue, stream]; GOTO PrintP; }; ];
lc _ LOOPHOLE[li];
};
time => lc _ LOOPHOLE[v.value];
ENDCASE => { Signal[TypeMismatch, stream]; GOTO PrintP; };
SELECT char FROM
'b => r _ CVText[[unsigned[lc, 8]]];
'd => r _ CVText[IF val.type = integer THEN [signed[li, 10]]
ELSE [unsigned[lc, 10]]];
'x => r _ CVText[[unsigned[lc, 16]]];
ENDCASE => { Signal[NotImplementedForThisStream, stream]; RETURN; };
PrintText[r, NIL, format, stream, FALSE];
EXITS
PrintP => PrintPounds[stream];
};

Zero: REAL = 0;
Ten: REAL = 10;
ULim: REAL = 999999;
LLim: REAL = Ten/10000;
FPRoutine: PFCodeProc = TRUSTED -- RefText
{
t: REF TEXT _ RefText.ObtainScratch[40];
s: STRING _ [40];
r: REAL;
i: CARDINAL _ 0;
leftPart: BOOLEAN _ TRUE;
mrc: CARDINAL _ 0;
c: CHAR;
pp: PROC [a: CHAR] = CHECKED { t[t.length] _ a; t.length _ t.length+1; };
WITH v: val SELECT FROM
boolean => r _ IF v.value THEN 1 ELSE 0;
character => r _ LOOPHOLE[v.value, CARDINAL];
cardinal => r _ v.value;
integer => r _ v.value;
real => r _ v.value;
time => r _ LOOPHOLE[v.value, LONG CARDINAL];
ENDCASE => {
Signal[TypeMismatch, stream];
THROUGH [0..5) DO stream.PutChar['#]; ENDLOOP;
RETURN;
};
FOR i: INT IN [format.first..format.form.Length[]) DO
c _ format.form.Fetch[i];
SELECT c FROM
'- => NULL;
'. => leftPart _ FALSE;
IN ['0..'9] => IF ~leftPart THEN mrc _ mrc*10 + (c - '0);
ENDCASE => EXIT;
ENDLOOP;
AppendFloatTo[
R: r, pProc: pp, lp: leftPart, rc: mrc, EFormat: char='e !
Real.RealException => RESUME [FALSE]];

IF format.form.Fetch[format.first]='0 THEN format.first _ SUCC[format.first];
PrintText[t, NIL, format, stream, FALSE];
};

AppendChar: PROC [s: LONG STRING, c: CHAR] = TRUSTED
{
s[s.length] _ c;
s.length _ s.length+1;
};

AppendFloatTo: PROC [
R: REAL, pProc: PROC [CHARACTER], lp: BOOLEAN, rc: CARDINAL,
EFormat: BOOLEAN] = TRUSTED
{
Q, M, S: REAL;
pdl: ARRAY [0..40] OF [0..10);
sindex: CARDINAL;
fexp, k, U: INTEGER;
iPart: LONG INTEGER;
expt: INTEGER _ 0;
NotFill, LastWasDot, Digits, DecimalPt: BOOLEAN _ FALSE;
outS: STRING _ [20];
fracS: STRING _ [20];
rounds: ARRAY [0..20] OF REAL =
[0.5e-0, 0.5e-1, 0.5e-2, 0.5e-3, 0.5e-4, 0.5e-5, 0.5e-6, 0.5e-7, 0.5e-8,
0.5e-9, 0.5e-10, 0.5e-11, 0.5e-12, 0.5e-13, 0.5e-14, 0.5e-15, 0.5e-16,
0.5e-17, 0.5e-18, 0.5e-19, 0.5e-20];
ExptMark: PROC = CHECKED {
IF EFormat AND ~DecimalPt THEN {expt _ k; DecimalPt _ TRUE; }; };
Output: PROC [c: CHARACTER] = CHECKED {
AppendChar[IF DecimalPt THEN fracS ELSE outS, c]; };
LeftFill: PROC = CHECKED {
IF NOT EFormat THEN THROUGH [1..k] DO Output['0]; ENDLOOP; };
FracOut: PROC [i: INTEGER] = CHECKED {
IF i # 0 THEN NotFill _ TRUE;
IF NotFill THEN {Output['0 + i]; ExptMark[]; }
ELSE {IF NOT EFormat THEN Output['0]; };
};
PrintIt: PROC = TRUSTED {

IF rc > 0 THEN fracS.length _ MIN[rc, fracS.length];
FOR sindex IN [0..outS.length) DO pProc[outS[sindex]]; ENDLOOP;
IF fracS.length > 0 THEN {
pProc['.];
FOR sindex IN [0..fracS.length) DO pProc[fracS[sindex]]; ENDLOOP;
};
IF EFormat THEN {
IF fracS.length = 0 THEN {pProc['.]; pProc['0]; };
pProc['e];
IF expt < 0 THEN {pProc['-]; expt _ -expt; } ELSE pProc['+];
pProc['0 + (expt/10)];
pProc['0 + (expt MOD 10)];
};
};

IF R = Zero THEN {Output['0]; PrintIt[]; RETURN; };
IF R < Zero THEN {Output['-]; R _ -R; };

IF R NOT IN [LLim..ULim] THEN {EFormat _ TRUE; };
IF NOT EFormat THEN IF NOT lp THEN R _ R + rounds[rc];

fexp _ LOOPHOLE[R, Ieee.SingleReal].exp - 127 - 24;
M _ Scale[1, fexp];
k _ 0;
Q _ R;
S _ 1;
WHILE Q >= LAST[LONG INTEGER] DO
pdl[k] _ 0; k _ k + 1; Q _ Q/Ten; S _ S*Ten; ENDLOOP;

iPart _ Real.Fix[Q];
WHILE iPart > 0 DO
pdl[k] _ iPart MOD 10;
iPart _ iPart/10;
k _ k + 1;
S _ S*Ten;
ENDLOOP;

Q _ R;
WHILE k > 0 DO
k _ k - 1;
S _ S/Ten;
U _ pdl[k];
Q _ Q - U*S;
IF Q NOT IN [M..S - M] THEN GO TO MaskExit;
Output['0 + U];
Digits _ TRUE;
ExptMark[];
REPEAT
MaskExit => {
IF 2*Q <= S THEN Output['0 + U] ELSE Output['0 + U + 1];
Digits _ TRUE;
ExptMark[];
LeftFill[];
};
ENDLOOP;

IF NOT EFormat THEN {IF NOT Digits THEN Output['0]; DecimalPt _ TRUE; };

IF fexp < 0 THEN {
k _ 0;
R _ R - Real.Fix[R]; -- Get fraction part.
DO
k _ k - 1;
R _ R*Ten;
U _Real.Fix[R];
R _ R - U;
M _ M*Ten;
IF lp THEN {IF R NOT IN [M..1 - M] THEN EXIT}
ELSE { IF fracS.length >= rc THEN EXIT;};
IF M>1 THEN EXIT;
FracOut[U];
ENDLOOP;
IF 2*R <= 1 THEN FracOut[U] ELSE FracOut[U + 1];
};

PrintIt[];

}; --end of WriteFloat
Scale: PROC [r: REAL, se: INTEGER] RETURNS [REAL] = TRUSTED
{
f: Ieee.SingleReal _ LOOPHOLE[r, Ieee.SingleReal];
exp: INTEGER;
exp _ f.exp + se;
IF exp <= 0 THEN RETURN[IF r < 0 THEN Real.MinusZero ELSE Real.PlusZero];
IF exp >= 377B THEN {
IF r < 0 THEN RETURN[Real.MinusInfinity] ELSE RETURN[Real.PlusInfinity]; };
f.exp _ exp;
RETURN[LOOPHOLE[f, REAL]];
};

LRoutine: PFCodeProc = TRUSTED 
{
WITH v: val SELECT FROM
rope => NULL;  -- font change, but not implemented for this stream.
ENDCASE => {
Signal[TypeMismatch, stream];
PrintPounds[stream];
};
};

NewLine: PFStarCodeProc = {
IO.NewLine[stream];
};

QRoutine: PFCodeProc = TRUSTED  {
WITH v: val SELECT FROM
rope => {
PutEscape: PROC [c: CHAR] RETURNS [BOOL] = TRUSTED{
IF c = '\\ OR c = '" THEN stream.PutChar['\\]; 
IF c < 40C OR c >= 177C THEN {
stream.PutChar['\\];
SELECT c FROM
'\n => stream.PutChar['n];
'\t => stream.PutChar['t];
ENDCASE => {
stream.PutChar['0 + (c - 0C) / 64]; 
stream.PutChar['0 + (c - 0C) MOD 64 / 8]; 
stream.PutChar['0 + (c - 0C) MOD 8]} 
}
ELSE stream.PutChar[c]; 
RETURN [FALSE];
};
[] _ Rope.Map[base: v.value, start: 0, action: PutEscape]; 
}; 

ENDCASE => {
Signal[TypeMismatch, stream];
PrintPounds[stream];
};
};

RRoutine: PFCodeProc =  TRUSTED {
et, hours1, minutes, seconds: LONG CARDINAL;
li: INT;
r: REF TEXT;
han: IO.STREAM;
WITH v: val SELECT FROM
cardinal => et _ v.value;
integer => et _ LOOPHOLE[v.value];
real => TRUSTED {
li _ RealOps.RoundLI[v.value ! Real.RealException =>
{ Signal[UnprintableValue, stream]; GOTO PrintP; }; ];
IF li < 0 THEN { Signal[UnprintableValue, stream]; GOTO PrintP; };
et _ li;
};
time => et _ LOOPHOLE[v.value];
ENDCASE => { Signal[TypeMismatch, stream]; GOTO PrintP; };
seconds _ et MOD 60;
et _ et/60;
minutes _ et MOD 60;
et _ et/60;
hours1 _ et MOD 100;
et _ et/100;
r _ RefText.ObtainScratch[50];
han _ CreateOutputStreamToText[r];
IO.PutF[han, "%g%02g:%02g:%02g", 
IF et # 0 THEN int[et] ELSE string[""L],
card[hours1],
card[minutes],
card[seconds]];
han.Close[];
PrintText[r, NIL, format, stream, FALSE];
EXITS
PrintP => PrintPounds[stream];
};

StringRoutine: PFCodeProc = TRUSTED
{
r: REF TEXT;
rp: ROPE;
WITH v: val SELECT FROM
boolean => rp _ IF v.value THEN "TRUE" ELSE "FALSE";
character => {
r _ RefText.ObtainScratch[1];
r[0] _ v.value;
r.length _ 1;
};
cardinal => r _ CVText[[unsigned[v.value, 10]]];
integer => r _ CVText[[signed[v.value, 10]]];
string => r _ StringToRefText[v.value];
real => r _ CVText[[real[real: v.value, useE: FALSE]]];
rope => rp _ v.value;
text => rp _ ThinkRope[v.value];
time => r _ CVText[[time[time: LOOPHOLE[v.value],
useDate: TRUE, useTime: TRUE, useZone: TRUE]]];
ENDCASE => {
stream: STREAM _ CreateOutputStreamToRope[];
stream.Put[val]; rp _ stream.GetOutputStreamRope[];
stream.Close[];
};
PrintText[r, rp, format, stream, IF char = 'h THEN TRUE ELSE FALSE];
};

TRoutine: PFCodeProc = TRUSTED
{
t: System.GreenwichMeanTime;
li: INT;
WITH v: val SELECT FROM
integer => t _ LOOPHOLE[v.value];
cardinal => t _ LOOPHOLE[v.value];
real => {
li _ RealOps.RoundLI[v.value ! Real.RealException =>
{ Signal[UnprintableValue, stream]; GOTO PrintP; }; ];
IF li < 0 THEN { Signal[UnprintableValue, stream]; GOTO PrintP; };
t _ LOOPHOLE[li];
};
time => t _ v.value;
ENDCASE => { Signal[TypeMismatch, stream]; GOTO PrintP; };
PrintText[CVText[[time[time: t, useDate: TRUE, 
useTime: TRUE, useZone: TRUE]]],
NIL, format, stream, FALSE];
EXITS
PrintP => PrintPounds[stream];
};

ThinkRope: PROC [r: REF READONLY TEXT] RETURNS [ROPE] = TRUSTED INLINE {
RETURN[LOOPHOLE[r]]; };

StringToRefText: PROC [text: LONG STRING] RETURNS [REF TEXT] = TRUSTED { -- RefText
t: REF TEXT;
IF text = NIL THEN RETURN[RefText.ObtainScratch[0]];
t _ RefText.ObtainScratch[text.length];
FOR i: CARDINAL IN [0..text.length) DO t[i] _ text[i]; ENDLOOP;
t.length _ text.length;
RETURN[t];
};

PrintText: PROC [
text: REF TEXT, rp: ROPE, format: Format, stream: STREAM, visiblecc: BOOLEAN] = TRUSTED
{
tlength: CARDINAL;
ladj: BOOLEAN _ FALSE;
fill0: BOOLEAN _ FALSE;
w: CARDINAL _ 0;
k: CARDINAL;
ch: CHARACTER;
MyPut: PROC [c: CHAR] RETURNS [BOOL] = CHECKED { stream.PutChar[c]; RETURN[FALSE]; };
IF text#NIL THEN tlength _ text.length ELSE tlength _ rp.Length[];
IF format.form.Length[] > 0 THEN {
v: Convert.Value;
IF format.form.Fetch[format.first] = '0 THEN { fill0 _ TRUE; format.first _ SUCC[format.first]; };
IF format.form.Fetch[format.first] = '- THEN {ladj _ TRUE; format.first _ SUCC[format.first]; };
v _ Convert.Parse[text: [rope[format.form]], pos: format.first].value;
w _ WITH val: v SELECT FROM
unsigned  => val.unsigned,
signed    => IF val.signed < 0 THEN 0 ELSE val.signed,
real      => RealOps.RoundC[val.real ! Real.RealException => TRUSTED {CONTINUE}]
ENDCASE => 0;
};
w _ MAX[w, tlength];
k _ IF w < tlength THEN 0 ELSE w - tlength;
IF ~ladj THEN THROUGH [1..k] DO stream.PutChar[IF fill0 THEN '0 ELSE ' ] ENDLOOP;
IF visiblecc THEN FOR j: NAT IN [0..tlength) DO
ch _ IF text#NIL THEN text[j] ELSE rp.Fetch[j];
IF ch < 40C THEN {stream.PutChar['^]; stream.PutChar[ch + LOOPHOLE['@, CARDINAL]]; }
ELSE stream.PutChar[ch];
ENDLOOP
ELSE {
IF text#NIL THEN stream.PutBlock[text]
ELSE [] _ Rope.Map[base: rp, action: MyPut];
};
IF ladj THEN THROUGH [1..k] DO stream.PutChar[' ] ENDLOOP;
IF text#NIL THEN RefText.ReleaseScratch[text];
};  --FormatText

CVText: PROC [v: Convert.Value] RETURNS [REF TEXT] = TRUSTED -- Convert
{
t: REF TEXT _ RefText.ObtainScratch[20];
PutChar: PROC [c: CHAR] = CHECKED {
IF t.length>=t.maxLength THEN TRUSTED -- RefText
{
temp: REF TEXT _ RefText.ObtainScratch[t.maxLength*2];
FOR i: CARDINAL IN [0..t.length) DO temp[i] _ t[i]; ENDLOOP;
temp.length _ t.length;
RefText.ReleaseScratch[t];
t _ temp;
};
t[t.length] _ c;
t.length _ t.length+1;
};
Convert.MapValue[put: PutChar, value: v];
RETURN[t];
};

PrintPounds: PROC [stream: STREAM] = { THROUGH [0..5) DO stream.PutChar['#]; ENDLOOP; };
Create: PROC [] = {
prototypePFStreamData _ NEW[PFStreamRecord _ []];  -- initialized
prototypePFStreamData.procArray['b] _ NumRoutine;
prototypePFStreamData.procArray['c] _ StringRoutine;
prototypePFStreamData.procArray['d] _ NumRoutine;
prototypePFStreamData.procArray['e] _ FPRoutine;
prototypePFStreamData.procArray['f] _ FPRoutine;
prototypePFStreamData.procArray['g] _ StringRoutine;
prototypePFStreamData.procArray['h] _ StringRoutine;
prototypePFStreamData.procArray['l] _ LRoutine;
prototypePFStreamData.procArray['r] _ RRoutine;
prototypePFStreamData.procArray['s] _ StringRoutine;
prototypePFStreamData.procArray['t] _ TRoutine;
prototypePFStreamData.procArray['x] _ NumRoutine;
prototypePFStreamData.procArray['q] _ QRoutine;  -- quoted rope, prints rope with \'s inserted where necessary
prototypePFStreamData.starProcArray['n] _ NewLine;

};  -- Create

Create[];

}.

MODULE HISTORY
Created by Schmidt, July 1977

Changed by Schmidt, August 19, 1977  8:06 PM
Reason: to delete wf5 - wf9, put in setwriteprocedure, and add a test for a NIL string

Changed by Schmidt, August 19, 1977  8:23 PM
Reason:  deconvert from dboss

Changed by Mitchell, June 13, 1978  9:48 PM
Reason:  Convert to Mesa 4.0

Chnaged by Schmidt, June 26, 1978  11:21 PM
Reason: add %i, %l to stream 32-bit integers

Changed by LStewart, June 19, 1979  11:04 AM
Reason:  Convert to Mesa 5.0

Changed by LStewart, July 10, 1979  5:10 PM
Reason:  Field width on long octal.  Non-recursive number printer

Changed by Gifford, September 15, 1980  5:19 PM
Reason: Convert to Pilot, eliminate stream stuff

Changed by Israel, October 3, 1980  12:02 PM
Reason: Change InlineDefs to Inline, intialize uninitialized variables

Changed by Schmidt, January 10, 1981  4:06 PM
Reason: Add FPF stuff

Changed by MBrown, June 11, 1981  2:31 PM
Reason: Rewrite for Cedar.

Changed by Schmidt, 29-Aug-81 13:30:39
Reason:  convert to use Cedar Refs, Ropes, etc.

Changed by Stewart, 30-Aug-81  1:27:15
Reason:  Fix S and SN, made Process safe.

Changed by Stewart, 12-Sep-81 16:49:26
Reason:  Fix format string scanner, make format string a Rope

Changed by Stewart, 15-Sep-81 15:29:15
Reason:  READONLY, Remove allocates, simplify PFInternal, Combine CodeProcs

Changed by Stewart, 11-Nov-81  1:18:48
Reason:  Cedar 2.1, eliminate CedarIO stuff, preparatory to IO

Changed by Stewart, 16-Nov-81 17:41:36
Reason:  IO

Changed by Stewart,  4-Dec-81 21:16:00
Reason:  Efficiency

Changed by Teitelman, August 12, 1982 4:41 pm
Reason:  StringToRefText assumed that its argument was always non-NIL

Changed by Teitelman, August 25, 1982 12:58 pm
Reason:  Fixed bug in PutFL wherein it was not printing the remainder of the format.

Changed by Teitelman, January 3, 1983 9:38 pm
Reason:  Changed LRoutine to a NOP. L is now used to change fonts for those streams that implement it, mainly viewer streams. Making it a nop means that caller does not have to know whether is implemented. Note that printing of boolean can be done with %g.

Changed by Teitelman, January 21, 1983 5:49 pm
Reason:  changed pfprocs to use backingStream if a particular operation not implemented before they signal notimplemented. deimplemented other built in * operations such as *r *t etc. since these can now be done with \.



LIOPFImpl.mesa
Last edited by
MBrown on June 11, 1981  2:32 PM
Schmidt on 31-Aug-81 21:39:19
Stewart on 20-Jan-82 19:15:39
Teitelman on  January 21, 1983 5:31 pm
MDS usage:
This procedure does all the real work for PutF, PutFList, PutFL
If the Value is a refAny variant, try to make it more concrete.
pp: REF READONLY ANY _ WITH v: arg SELECT FROM
refAny => v.value
ENDCASE => SIGNAL;
c is a conversion character,
and conversionFormat is the stuff between % and c.
these are the routines for each letter, e.g. %b, etc
This procedure streams 'b, 'd, and 'x.
This procedure streams 'e, and 'f.
conversion from LONG CARDINAL to REAL doesn't work, but...
get format left and right
Now think about printing the stuff out.
We have a string of integer and possible leading '- in outS,
a string of fraction digits in fracS, and possible decimal
point and exponent.
Print leading stuff.
Print fraction, if there.
Print exponent.
EFormat requires at least x.0e+yy.
Force E Format.
Establish the termination condition mask. The value of
mask is 1/2 the value of the least significant bit
of the mantissa of R.
Prescale into the range of LONG INTEGER.
Accumulate the rest of the digits of integer representation.
always at least one thing on pdl
now, R has fractional part and S=1
Output some fraction digits if there were any.
That we will output any fraction digits means that
1) the integer part has been printed exactly, and
2) the Fix below will not trap.
Take apart a REAL so that m*2^e = r
Multiply a REAL by a power of 2
QuotedRope, prints ropes with \'s inserted where necessary.
Prints text to stream, while enforcing simple format
specifications: field width, left or right justification,
zero-filling.  Used by conversion routines that first buffer full
output in text, then format it here.
Our policy is to print all of text, even if the format specifies
a smaller width.
Keeps no REF to text or format, so they can safely be
overwritten.
general form of format:  [0|-|][num.num]
THIS USED TO CAUSE COMPILER ERROR
w is field width, k is # chars to fill
utilities
INITIALIZATION CODE
-- built in % codes
Mainline Code
�ÊR˜Jš
œ
™
Jš
œ™Jš
œ ™ Jš
œ™Jš
œ™Jš
œ&™&J˜š
Ïk	˜	Jšœ�œ˜'Jšœ�œ˜Jš�œ
�œå
�œ�œ˜ŠJšœ�œ!˜.Jšœ�œH˜RJšœ�œ˜ Jšœ�œ˜'šœ�œ˜ J˜
J˜——J˜JšÐblœ�œ
�˜J˜Jš�œ
�œ˜1J˜Jš�œ
�˜
J˜Jš�œ
�œ˜J˜šœ
�œ
�œ
˜	J˜—J˜JšÏnœ�œ�œ˜(šŸœ�œ�œ
˜Jšœ�œ
�	œ
�œ�œ
�œ˜=Jšœ�œ
�	œ
�œ�œ
�œ
˜DJ˜J˜Jš
œ
™
—JšŸœ�œ
˜*J˜š
Ÿ
œ�œ
�œ
�œ�	œ˜UJ˜
Jš�œ�œ
�œ˜1Jš�œ�œ
�œ
�œ,˜Hš�œ˜J˜5J˜ J˜—J˜J˜—š
Ÿœ�œ
�œ
�œ�	œ˜]J˜
Jš�œ�œ
�œ˜1Jš�œ�œ
�œ
�œ,˜Hš�œ˜J˜5J˜$J˜—J˜J˜—šŸœ�œ
�œ�œ˜OJšœ�œ
�œ"˜0Jš�œ	�œ
�œ�œ˜(š�œ˜Jšœ�œ*˜4J˜#J˜—J˜J˜—šŸœ�œ
�œ
�œ
�œ�œ*˜_J˜
Jšœ�œ˜Jšœ�œ˜Jš�œ�œ)˜=Jš�œ�œ)˜=Jš�œ�œ*˜>Jš�œ�œ)˜=Jš�œ�œ*˜>Jš�œ	�œ/˜>J˜J˜—š	Ÿœ�œ
�œ�œ�˜IJšœ�œ!˜-Jš�œ�œ
�œ˜,Jš
œ˜—J˜šŸœŸœ�œ
�œ
�œ
�œ�œ�œ
�œ	˜Xš
�˜Jšœ�œ˜—Jšœ�œ˜š�œ�œ
�œ
�œ�œ�˜:Jš�œ.˜0Jš�œ
˜Jš�œ	�œ/˜>—Jš�œ˜J˜Jš
œ?™?—š
Ÿ
œ�œ
�œ
�œ
�œ
˜?Jšœ�œ�œ�˜#J˜Jšœ�œ˜"Jšœ�œ
˜Jšœ�	œ˜šŸœ�œ�œ
�œ˜,Jšœ)�œ˜<—Jš
œ?™?š�œ�œ˜š
œ.™.Jš
œ™Jš
œ™—Jš	œ�œ
�œ
�œ�œ˜8šœ�œ�œ
�˜Jšœ�œ
�œ
�œ˜&Jšœ�œ
�œ
�	œ˜(Jšœ�œ
�œ
�œ˜'Jš	œ�œ
�œ
�œ
�œ˜,Jšœ�œ
�œ
�œ
˜%Jšœ�œ
�œ
�œ
˜!Jšœ�œ
�œ
�œ
˜!Jšœ�œ
�œ
�œ˜#Jšœ�œ
�œ
�œ
˜"Jšœ�œ
�œ&˜6Jš�œ˜—J˜—š�œ�œ˜J˜6Jš�œ�œ
�œ0�œ
˜MJš�œ�œ�œ	˜2J˜—Jš�œ�œ"�œ	˜Nš�œ�œ˜!J˜š�œ�˜
˜J˜š
�˜Jš�œ�œ"�œ˜PJ˜Jš�œ�œ
�œ�œ
�œ�œ
�œ
˜6Jš�œ
˜—Jš
œ™Jš
œ2™2š�œ�œ�œ˜(Jšœ�œ
˜J˜Jš�œ�œ"�œ˜FJš�œ�œ
�œ˜(š
�˜Jš
œ&˜&Jš
œ˜Jš�œ�œ
�œ.�œ
˜BJš�œ
�œ�œ
�œ˜6š�œ˜J˜,J˜Jš�œ
˜J˜—Jš�œ
˜—Jš�œ˜
J˜—JšœÏc˜—˜J˜š�œ�˜
J˜&J˜J˜J˜š�œ #˜5Jšœ�œ
˜Jš
�œ�œ
�œ
�œ
�œ˜&J˜J˜Jš
�œ�œ
�œ
�œ
�œ˜&J˜J˜Jš
�œ�œ
�œ
�œ
�œ˜&J˜Jšœ�œ˜—Jš�œ˜—Jš
�˜Jšœ+�œ˜>J˜—˜˜Jš�œ�œ
�œ˜(Jš�œ�œ
�œ
�œ˜+š�œ˜J˜Jšœ�œ
˜š
�˜Jš
œ&˜&Jš
œ˜Jš�œ�œ
�œ�œ
˜!Jš�œ
�œ�œ
�œ˜6š�œ˜J˜,Jš�œ˜J˜—Jš�œ
˜—J˜—J˜——Jš�œ˜—Jš
�˜J˜"J˜Jš�œ
˜—Jš�œ�œ˜4Jš
�˜J˜Jšœ�œ
˜
J˜Jš�œ
˜Jšœ ˜J˜Jš
œ4™4Jš
œ&™&—šŸ
œ�˜ ˜
Jšœ�œ
˜Jšœ�œ
�œ
˜Jšœ�œ
�œ
˜š�œ�œ
�˜Jšœ�œ	�œ�œ˜)Jšœ�œ
�œ
�œ˜4J˜Jšœ �œ˜0˜	˜4Jšœ$�œ˜6—Jšœ�œ˜J˜—Jšœ
�œ
˜Jš�œ$�œ˜:—š�œ�˜J˜$šœ�œ�œ˜<Jš�œ˜—J˜%Jš�œ3�œ˜D—Jšœ
�œ�œ˜)Jš
�˜J˜J˜J˜——JšŸœ�œ˜JšŸœ�œ˜JšŸœ�œ
˜šŸœ�œ
˜Jš
œ"™"—šŸ	œ�œ
 
˜*˜
Jšœ�œ
�œ˜(Jšœ�œ˜Jšœ�œ
˜Jšœ�œ˜Jšœ
�œ�œ
˜Jšœ�œ˜Jšœ�œ
˜Jšœ�œ�œ�œ-˜IJš
œ:™:š�œ�œ
�˜Jšœ�œ	�œ�œ˜(Jšœ�œ
�œ˜-J˜J˜J˜Jšœ�œ
�œ
�œ˜-š�œ˜J˜Jš�œ�œ�œ
˜.Jš�œ
˜J˜——Jš
œ™š�œ�œ
�œ&�˜5J˜Jš�œ�˜
šœ�œ
˜Jšœ�œ
˜Jš�œ
�œ�œ˜9Jš�œ�œ
˜—Jš�œ
˜—˜Jš�
œ9˜:Jšœ�œ�œ˜&J˜—Jš�œ$�œ�œ˜MJšœ
�œ�œ˜)J˜J˜——šŸ
œ�œ�œ
�œ�œ�˜4˜
J˜J˜J˜J˜——šŸ
œ�œ˜Jš�
œ�œ	�œ�	œ�œ�œ
˜<Jšœ	�œ�˜J˜
Jš�
œ�
œ�
œ�œ
˜Jšœ�œ	�œ	˜Jšœ�œ
˜Jšœ	�
œ�œ
˜Jšœ�œ
�œ
˜Jšœ�œ˜Jšœ(�œ�œ
˜8Jšœ�œ˜Jšœ�œ˜šœ�œ	�œ
�œ˜˜HJ˜FJ˜$——šŸœ�œ�œ˜Jš�œ	�œ�œ�œ˜A—šŸœ�œ�	œ�œ˜'Jšœ�œ�œ�œ
˜4—šŸœ�œ�œ˜Jš�œ
�œ	�œ
�œ�œ
�œ˜=—šŸœ�œ�œ�œ˜&Jš�œ�œ�œ
˜Jš�œ	�œ˜.Jš�œ�œ
�œ	�œ˜(J˜—šŸœ�œ�œ˜Jš
œ'™'Jš
œ<™<Jš
œ:™:Jš
œ™J˜Jš
œ™Jš�œ�œ�œ˜4Jš�œ�œ�œ�œ
˜?Jš
œ™š�œ�œ˜J˜
Jš�œ�œ�œ�œ
˜AJ˜—Jš
œ™š�œ	�œ˜Jš
œ"™"Jš�œ�œ˜2J˜
Jš�œ
�œ�œ˜<J˜Jšœ�œ˜J˜—J˜J˜Jš�œ
�
œ�œ�œ˜3—Jš
�œ
�
œ�œ�
œ�
œ˜(J˜Jš
œ™Jš�œ
�
œ
�œ
�œ�œ�œ˜1Jš�œ
�œ	�œ
�œ
�œ�œ
�
œ�
œ˜6J˜Jš
œ6™6Jš
œ2™2Jš
œ™Jšœ�œ
�
œ"˜3Jš�
œ˜J˜Jš�
œ�
œ
˜Jš�
œ˜Jš
œ(™(š�œ
�
œ�œ
�œ
�œ�˜ Jšœ�
œ�
œ�
œ�
œ�œ
˜5J˜—Jš
œ<™<Jšœ�
œ˜š�œ�˜Jšœ�œ˜J˜J˜
Jš�
œ�
œ˜
Jš�œ
˜J˜—Jš�
œ�
œ
˜š�œ�˜Jš
œ ™ J˜
Jš�
œ�
œ˜
Jš�
œ
˜Jš�
œ�
œ�
œ
�
œ
˜Jš�œ
�
œ
�œ
�œ�
œ�
œ�
œ�œ
�œ
�œ
˜+Jšœ�
œ˜Jšœ	�œ
˜J˜š
�˜˜
Jš�œ�
œ�
œ
�œ
�
œ�œ
�
œ˜8Jšœ	�œ
˜J˜J˜J˜——Jš�œ
˜J˜—Jš�œ
�œ	�œ�œ
�œ�œ�œ˜HJ˜Jš
œ"™"Jš
œ.™.Jš
œ2™2Jš
œ1™1Jš
œ™š�œ
�œ˜J˜Jš�
œ�
œ�
œ ˜*š
�˜J˜
Jš�
œ�
œ˜
Jš�
œ�
œ˜Jš�
œ�
œ�
œ
˜
Jš�
œ�
œ˜
Jš�œ�œ�œ
�
œ
�œ
�œ�
œ�
œ�œ
�œ
˜-Jš�œ�œ�œ
�œ˜)Jš�œ
�
œ�œ
�œ
˜Jšœ�
œ˜Jš�œ
˜—Jš�œ�
œ�œ	�
œ�œ	�
œ˜0J˜J˜—J˜
J˜Jšœ ˜Jš
œ#™#Jš
œ™—š
Ÿœ�œ�œ�œ�œ�œ�˜;J˜
Jšœ�œ˜2Jšœ�œ
˜
J˜Jš�œ
�œ
�œ
�œ�œ�œ˜Iš�œ
�œ˜Jš
�œ�œ
�œ�œ
�œ˜K—J˜Jš�œ
�œ�œ˜J˜J˜—šŸœ�˜˜
š�œ�œ
�˜Jšœ�œ 4˜Cš�œ˜J˜J˜J˜——J˜J˜——šŸœ�
˜Jš�œ˜˜J˜——šŸœ�œ˜!J™;š�œ�œ
�˜š
œ	˜	šŸ	œ�œ�œ�œ�œ�œ
˜3Jš�œ	�œ�œ˜/š�œ	�œ�˜J˜š�œ�˜
J˜J˜š�œ˜J˜$Jšœ�œ
˜*Jšœ�œ˜%J˜
——Jš�œ˜—Jš�œ�œ˜J˜—J˜;J˜J˜—š�œ˜J˜J˜J˜—J˜J˜——šŸœ�	˜!Jšœ�œ
�œ
˜,Jšœ�œ
˜Jšœ�œ
�œ
˜Jšœ�œ
�œ
˜š�œ�œ
�˜J˜Jšœ�œ
˜"šœ�œ˜˜4Jšœ$�œ˜6—Jš�œ�œ%�œ˜BJ˜J˜—Jšœ
�œ
˜Jš�œ$�œ˜:—Jšœ
�œ˜J˜Jšœ
�œ˜J˜Jšœ�œ˜J˜J˜J˜"š�œ˜!Jš�œ�œ	�œ
˜(J˜
J˜J˜—J˜Jšœ
�œ�œ˜)Jš
�˜J˜J˜J˜—šŸ
œ�˜#J˜
Jšœ�œ
�œ
˜Jšœ�œ
˜	š�œ�œ
�˜Jšœ�œ	�œ�œ	˜4˜J˜J˜J˜
J˜—J˜0J˜-J˜'Jšœ.�œ˜7J˜J˜ šœ�œ
˜1Jšœ	�œ�œ�œ˜/—š�œ˜Jšœ�œ˜,J˜3J˜J˜——Jšœ!�œ�œ
�œ
�œ
�œ˜DJ˜J˜—šŸœ�˜˜
J˜Jšœ�œ
˜š�œ�œ
�˜Jšœ�œ
˜!Jšœ�œ
˜"˜	˜4Jšœ$�œ˜6—Jš�œ�œ%�œ˜BJšœ�œ˜J˜—J˜Jš�œ$�œ˜:—šœ)�œ˜/Jšœ	�œ�œ˜ Jš�œ�œ˜Jš
�˜J˜—J˜J˜——šŸ	œ�œ�œ
�œ
�œ�œ�œ�œ
�œ˜HJš�œ
�œ˜J˜—šŸœ�œ�œ
�œ�œ�œ
�œ�	œ
 
˜SJšœ�œ
�œ
˜Jš�œ�œ
�œ
�œ˜4J˜'Jš
�œ�œ
�œ�œ�œ
˜?J˜Jš�œ˜
J˜J˜—šŸ	œ�œ˜Jšœ�œ
�œ�œ�œ
�œ�˜WJ˜
Jš
œ4™4Jš
œ9™9Jš
œA™AJš
œ$™$Jš
œ@™@Jš
œ™Jš
œ5™5Jš
œ™Jš
œ(™(Jšœ	�œ
˜Jšœ�œ�œ
˜Jšœ�œ�œ
˜Jšœ�œ˜Jšœ�œ
˜Jšœ�	œ
˜JšŸœ�œ�œ�œ�œ�œ�œ
�œ˜UJš
œ!™!Jš�œ�œ
�œ�œ˜Bš�œ�œ˜"J˜Jš�œ&�œ�œ�œ˜bJš�œ&�œ	�œ�œ˜`J˜Fšœ�œ�œ
�˜J˜Jšœ
�œ�œ�œ˜6Jšœ=�œ�œ˜PJš�œ˜
—J˜—Jšœ�œ
˜Jšœ�œ
�œ�œ
˜+Jš
œ&™&Jš�œ�œ
�œ�œ�œ�œ�œ�œ
˜Qš�œ�œ
�œ�œ
�œ�˜/Jš	œ�œ�œ
�œ	�œ
˜/Jš�œ
�œ*�œ�œ˜TJš�œ˜Jš
�˜—š�œ˜Jš�œ�œ
�œ˜&Jš�œ(˜,J˜—Jš
�œ�œ
�œ�œ�œ
˜:Jš�œ�œ
�œ˜.Jšœ ˜J˜Jš
œ	™	—š
Ÿœ�œ�œ�œ
�œ�œ
 
˜GJ˜
Jšœ�œ
�œ˜(šŸœ�œ�œ�œ˜#Jš�œ�œ
�œ
 
˜0˜
Jšœ�œ
�œ(˜6Jš
�œ�œ
�œ�œ�œ
˜<J˜J˜J˜	J˜—J˜J˜J˜—J˜)Jš�œ˜
J˜J˜—šŸœ�œ
�œ�œ�œ�œ˜XJš
œ™—šŸœ�œ˜Jšœ�œ ˜AJš
œ™J˜1J˜4J˜1J˜0J˜0J˜4J˜4J˜/J˜/J˜4J˜/J˜1Jšœ1 =˜nJ˜2J˜Jšœ 	˜
J˜—Jš
œ
™
˜	J˜—˜˜Jš�œ
�˜——J˜J˜Jšœ*�˜,JšœL�œ˜VJ˜Jšœ*�˜,J˜J˜Jšœ)�˜+J˜J˜Jšœ)�˜+J˜,J˜Jšœ*�˜,J˜J˜Jšœ)�˜+J˜AJ˜Jšœ-�˜/J˜0J˜Jšœ*�˜,J˜FJ˜Jšœ+�˜-Jšœ�œ˜J˜Jšœ'�˜)J˜J˜J˜&J˜/J˜J˜&Jšœ
�
œ�œ˜)J˜J˜&J˜=J˜J˜&Jšœ	�œ:˜KJ˜J˜&Jšœ<�˜>J˜J˜&Jšœ	�˜J˜J˜&J˜J˜J˜-JšœB�˜EJ˜J˜.J˜TJ˜J˜-J˜€J˜J˜.J˜Û
J˜J˜J˜—…—M\qú