[Indigo]<Cedar>IO>IOPFImpl.mesa!5

IOPFImpl.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

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]

];

MDS usage:

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;

This procedure does all the real work for PutF, PutFList, PutFL

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 the Value is a refAny variant, try to make it more concrete.

IF arg.type=refAny THEN {

pp: REF READONLY ANY ← WITH v: arg SELECT FROM

refAny => v.value

ENDCASE => SIGNAL;

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;

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;

c is a conversion character,

and conversionFormat is the stuff between % and c.

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];

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;

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

these are the routines for each letter, e.g. %b, etc

This procedure streams 'b, 'd, and 'x.

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;

This procedure streams 'e, and 'f.

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; };

conversion from LONG CARDINAL to REAL doesn't work, but...

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;

};

get format left and right

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 {

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.

IF rc > 0 THEN fracS.length ← MIN[rc, fracS.length];

FOR sindex IN [0..outS.length) DO pProc[outS[sindex]]; ENDLOOP;

Print fraction, if there.

IF fracS.length > 0 THEN {

pProc['.];

FOR sindex IN [0..fracS.length) DO pProc[fracS[sindex]]; ENDLOOP;

};

Print exponent.

IF EFormat THEN {

EFormat requires at least x.0e+yy.

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; };

Force E Format.

IF R NOT IN [LLim..ULim] THEN {EFormat ← TRUE; };

IF NOT EFormat THEN IF NOT lp THEN R ← R + rounds[rc];

Establish the termination condition mask. The value of

mask is 1/2 the value of the least significant bit

of the mantissa of R.

fexp ← LOOPHOLE[R, Ieee.SingleReal].exp - 127 - 24;

M ← Scale[1, fexp];

k ← 0;

Q ← R;

S ← 1;

Prescale into the range of LONG INTEGER.

WHILE Q >= LAST[LONG INTEGER] DO

pdl[k] ← 0; k ← k + 1; Q ← Q/Ten; S ← S*Ten; ENDLOOP;

Accumulate the rest of the digits of integer representation.

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

always at least one thing on pdl

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; };

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.

IF fexp < 0 THEN {

k ← 0;

R ← R - Real.Fix[R]; -- Get fraction part.

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

Take apart a REAL so that m*2^e = r

Multiply a REAL by a power of 2

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 {

QuotedRope, prints ropes with \'s inserted where necessary.

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

{

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]

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]; };

THIS USED TO CAUSE COMPILER ERROR

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;

w is field width, k is # chars to fill

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

utilities

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; };

INITIALIZATION CODE

Create: PROC [] = {

prototypePFStreamData ← NEW[PFStreamRecord ← []]; -- initialized

-- built in % codes

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

Mainline Code

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 \.