DIRECTORY
Ascii USING [Lower],
BasicTime USING [earliestGMT, GMT, Update],
Convert,
IO,
IOUtils,
RefText,
Real,
RealOps USING [RoundLI],
Rope;

IOPrintImpl: CEDAR MONITOR
IMPORTS Ascii, BasicTime, Convert, IO, IOUtils, RefText, Real, RealOps, Rope
EXPORTS IO, IOUtils
= BEGIN

ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Value: TYPE = IO.Value;
Format: TYPE = IOUtils.Format;
PFCodeProc: TYPE = IOUtils.PFCodeProc;
PFErrorProc: TYPE = IOUtils.PFErrorProc;

defaultTextSize: NAT _ 64;
PutRope: PUBLIC PROC [self: STREAM, r: ROPE] =  {
len: INT _ Rope.InlineLength[r];
WITH r SELECT FROM
t: Rope.Text => self.streamProcs.putBlock[self, RefText.TrustTextRopeAsText[t], 0, len];
ENDCASE => {
scratch: REF TEXT = RefText.ObtainScratch[defaultTextSize];
pos: INT _ 0;
WHILE len > 0 DO
moved: NAT _ scratch.length _ 0;
moved _ Rope.AppendChars[scratch, r, pos, len];
self.streamProcs.putBlock[self, scratch, 0, moved];
len _ len - moved;
pos _ pos + moved;
ENDLOOP;
RefText.ReleaseScratch[scratch];
};
};

PutText: PUBLIC PROC [self: STREAM, t: REF READONLY TEXT] = {
IF t # NIL THEN self.streamProcs.putBlock[self, t, 0, t.length];
};

Put: PUBLIC PROC [stream: STREAM, v1, v2, v3: Value] = {
scratch: REF TEXT = RefText.ObtainScratch[defaultTextSize];
InnerPut1[stream, v1, scratch];
InnerPut1[stream, v2, scratch];
InnerPut1[stream, v3, scratch];
RefText.ReleaseScratch[scratch];
};

Put1: PUBLIC PROC [stream: STREAM, value: Value] = {
scratch: REF TEXT = RefText.ObtainScratch[defaultTextSize];
InnerPut1[stream, value, scratch];
RefText.ReleaseScratch[scratch];
};

PutR1: PUBLIC PROC [value: Value] RETURNS [ROPE] = {
stream: STREAM = IO.ROS[];
scratch: REF TEXT = RefText.ObtainScratch[defaultTextSize];
InnerPut1[stream, value, scratch];
RefText.ReleaseScratch[scratch];
RETURN[IO.RopeFromROS[stream]];
};

PutR: PUBLIC PROC [v1, v2, v3: Value] RETURNS [ROPE] = {
stream: STREAM = IO.ROS[];
scratch: REF TEXT = RefText.ObtainScratch[defaultTextSize];
InnerPut1[stream, v1, scratch];
InnerPut1[stream, v2, scratch];
InnerPut1[stream, v3, scratch];
RefText.ReleaseScratch[scratch];
RETURN[IO.RopeFromROS[stream]];
};

PutL: PUBLIC PROC [stream: STREAM, list: LIST OF Value] = {
scratch: REF TEXT = RefText.ObtainScratch[defaultTextSize];
FOR l: LIST OF READONLY Value _ list, l.rest UNTIL l = NIL DO
InnerPut1[stream, l.first, scratch];
ENDLOOP;
RefText.ReleaseScratch[scratch];
};

PutLR: PUBLIC PROC [list: LIST OF Value] RETURNS [ROPE] = {
stream: STREAM = IO.ROS[];
scratch: REF TEXT = RefText.ObtainScratch[defaultTextSize];
FOR l: LIST OF READONLY Value _ list, l.rest UNTIL l = NIL DO
InnerPut1[stream, l.first, scratch];
ENDLOOP;
RefText.ReleaseScratch[scratch];
RETURN[IO.RopeFromROS[stream]];
};

InnerPut1: PROC [stream: STREAM, v: Value, scratch: REF TEXT] = {
scratch.length _ 0;
{
WITH v SELECT FROM
null: Value.null => NULL;
atom: Value.atom =>
PutRope[stream, Convert.RopeFromAtom[from: atom.value, quote: FALSE]];
bool: Value.boolean =>
PutRope[stream, Convert.RopeFromBool[bool.value]];
char: Value.character =>
stream.streamProcs.putChar[stream, char.value];
card: Value.cardinal => {
scratch _ Convert.AppendCard[scratch, card.value]; GO TO putBlock};
int: Value.integer => {
scratch _ Convert.AppendInt[scratch, int.value]; GO TO putBlock};
real: Value.real => {
scratch _ Convert.AppendG[scratch, real.value]; GO TO putBlock}; 
refAny: Value.refAny =>
PrintRef[stream, scratch, refAny.value];
rope: Value.rope =>
PutRope[stream, rope.value];
text: Value.text =>
PutText[stream, text.value];
time: Value.time => {
scratch _ Convert.AppendTime[to: scratch, from: time.value, start: $years, end: $seconds];
GO TO putBlock;
};
ENDCASE => ERROR;
EXITS putBlock => stream.streamProcs.putBlock[stream, scratch, 0, scratch.length];
};
};
globalPrintRefAny: IOUtils.PrintRefAnyProc _ NIL;

RegisterPrintRefAny: PUBLIC ENTRY PROC [printRefAnyProc: IOUtils.PrintRefAnyProc] = {
globalPrintRefAny _ printRefAnyProc;
};

GetPrintRefAny: ENTRY PROC [] RETURNS [IOUtils.PrintRefAnyProc] = {
RETURN [globalPrintRefAny]
};

PrintRef: PROC [stream: STREAM, scratch: REF TEXT, ref: REF READONLY ANY]  = {
printRefAnyProc: IOUtils.PrintRefAnyProc = GetPrintRefAny[];
IF printRefAnyProc = NIL THEN {
scratch _ RefText.AppendTextRope[scratch, "[REF: "];
scratch _ Convert.AppendCard[
to: scratch, from: LOOPHOLE[ref, LONG CARDINAL], base: 8, showRadix: TRUE];
scratch _ RefText.AppendChar[scratch, ']];
stream.streamProcs.putBlock[stream, scratch, 0, scratch.length];
}
ELSE {
printRefAnyProc[stream, ref, 4, 32, FALSE];
}
};
PFProcs: TYPE = REF PFProcsRecord;
PFProcsRecord: PUBLIC TYPE = RECORD [
procArray: ARRAY CHAR ['a..'z] OF PFCodeProc _ ALL[NIL],
errorProc: PFErrorProc _ NIL
];

globalPFProcs: PFProcs _ NIL;

GetDefaultPFProcs: ENTRY PROC [] RETURNS [PFProcs] = INLINE {
RETURN [globalPFProcs];
};

GetPFProcs: PROC [stream: STREAM] RETURNS [pfProcs: PFProcs] = INLINE {
pfProcs _ NARROW[IOUtils.LookupData[stream, $SetPFCode]];
IF pfProcs = NIL THEN pfProcs _ GetDefaultPFProcs[];
};

SetDefaultPFCodeProc: PUBLIC ENTRY PROC [char: CHAR, codeProc: PFCodeProc] RETURNS [previous: PFCodeProc] = {
char _ Ascii.Lower[char];
IF char NOT IN ['a..'z] THEN ERROR IO.Error[PFInvalidCode, NIL];
previous _ globalPFProcs.procArray[char];
globalPFProcs.procArray[char] _ codeProc;
};

SetDefaultPFErrorProc: PUBLIC ENTRY PROC [errorProc: PFErrorProc] RETURNS [previous: PFErrorProc] = {
previous _ globalPFProcs.errorProc;
globalPFProcs.errorProc _ errorProc;
};

CopyPFProcs: PUBLIC PROC [stream: STREAM] RETURNS [new: PFProcs] = {
pfProcs: PFProcs _
IF stream = NIL THEN NIL ELSE NARROW[IOUtils.LookupData[stream, $SetPFCode]];
IF pfProcs = NIL THEN pfProcs _ GetDefaultPFProcs[];
RETURN [NEW[PFProcsRecord _ pfProcs^]];
};

SetPFProcs: PUBLIC PROC [stream: STREAM, pfProcs: PFProcs] RETURNS [previous: PFProcs] = {
previous _ NARROW[IOUtils.LookupData[stream, $SetPFCode]];
IOUtils.StoreData[stream, $SetPFCode, pfProcs];
};

SetPFCodeProc: PUBLIC PROC [pfProcs: PFProcs, char: CHAR, codeProc: PFCodeProc] RETURNS [previous: PFCodeProc] = {
IF pfProcs = NIL THEN ERROR IO.Error[PFInvalidPFProcs, NIL];
char _ Ascii.Lower[char];
IF char NOT IN ['a..'z] THEN ERROR IO.Error[PFInvalidCode, NIL];
previous _ pfProcs.procArray[char];
pfProcs.procArray[char] _ codeProc;
};

SetPFErrorProc: PUBLIC PROC [pfProcs: PFProcs, errorProc: PFErrorProc] RETURNS [previous: PFErrorProc] = {
IF pfProcs = NIL THEN ERROR IO.Error[PFInvalidPFProcs, NIL];
previous _ pfProcs.errorProc;
pfProcs.errorProc _ errorProc;
};
PutF: PUBLIC PROC [stream: STREAM, format: ROPE, v1, v2, v3, v4, v5: Value] = {
pfProcs: PFProcs = GetPFProcs[stream];
fp: INT _ 0;
IF v1.type#null THEN fp _ PFInternal[stream, format, fp, v1, pfProcs];
IF v2.type#null THEN fp _ PFInternal[stream, format, fp, v2, pfProcs];
IF v3.type#null THEN fp _ PFInternal[stream, format, fp, v3, pfProcs];
IF v4.type#null THEN fp _ PFInternal[stream, format, fp, v4, pfProcs];
IF v5.type#null THEN fp _ PFInternal[stream, format, fp, v5, pfProcs];
[] _ PFInternal[stream, format, fp, [null[]], pfProcs];
};

PutF1: PUBLIC PROC [stream: STREAM, format: ROPE, value: Value] = {
pfProcs: PFProcs = GetPFProcs[stream];
fp: INT _ 0;
IF value.type#null THEN fp _ PFInternal[stream, format, fp, value, pfProcs];
[] _ PFInternal[stream, format, fp, [null[]], pfProcs];
};

PutFR: PUBLIC PROC [format: ROPE, v1, v2, v3, v4, v5: Value] RETURNS [ROPE] = {
stream: STREAM = IO.ROS[];
PutF[stream, format, v1, v2, v3, v4, v5];
RETURN [IO.RopeFromROS[stream]];
};

PutFR1: PUBLIC PROC [format: ROPE, value: Value] RETURNS [ROPE] = {
stream: STREAM = IO.ROS[];
pfProcs: PFProcs = GetPFProcs[stream];
fp: INT _ 0;
IF value.type#null THEN fp _ PFInternal[stream, format, fp, value, pfProcs];
[] _ PFInternal[stream, format, fp, [null[]], pfProcs];
RETURN [IO.RopeFromROS[stream]];
};

PutFL: PUBLIC PROC [stream: STREAM, format: ROPE, list: LIST OF Value] = {
pfProcs: PFProcs = GetPFProcs[stream];
fp: INT _ 0;
FOR l: LIST OF READONLY Value _ list, l.rest UNTIL l = NIL DO
fp _ PFInternal[stream, format, fp, l.first, pfProcs];
ENDLOOP;
[] _ PFInternal[stream, format, fp, [null[]], pfProcs];
};

PutFLR: PUBLIC PROC [format: ROPE, list: LIST OF Value] RETURNS [ROPE] = {
stream: STREAM = IO.ROS[];
PutFL[stream, format, list];
RETURN [IO.RopeFromROS[stream]];
};
PFInternal: PROC [stream: STREAM, format: ROPE, formatPtr: INT, arg: Value, pfProcs: PFProcs] RETURNS [--advancedFormatPtr--INT] = {
error: IO.ErrorCode _ $Null;
c: CHAR;
GetNextFromFormat: PROC[] = INLINE {
c _ format.InlineFetch[formatPtr]; formatPtr _ formatPtr.SUCC;
};
formatSize: INT _ format.InlineLength[];
IF formatSize = 0 THEN {
IF arg.type = null THEN GOTO Done
ELSE {
format _ "%g";  formatSize _ 2;  formatPtr _ 0 }
};
DO { -- EXITS PutC, HandleError
IF formatPtr >= formatSize THEN {
IF arg.type = null THEN GOTO Done
ELSE { --ran out of format while looking for '%
error _ PFFormatSyntaxError;  GOTO HandleError
}
};
GetNextFromFormat[];
IF c # '% THEN GOTO PutC;
{
savedFormatPointer: INT = formatPtr;
DO {
IF formatPtr >= formatSize THEN { --ran out of format while looking for code
error _ PFFormatSyntaxError;  GOTO HandleError
};
GetNextFromFormat[];
IF c IN ['a..'z] OR c IN ['A..'Z] THEN GOTO FoundCode;
IF c = '% THEN GOTO FoundPercent;
EXITS
FoundCode => EXIT;
FoundPercent => {  --found '% while looking for code
IF formatPtr = savedFormatPointer.SUCC THEN GOTO PutC;
error _ PFFormatSyntaxError;  GOTO HandleError
};
} ENDLOOP;
IF arg.type = null THEN { --no Value corresponding to '% in format
error _ PFFormatSyntaxError;  GOTO HandleError
};
c _ Ascii.Lower[c];
{
val: Value = WITH arg SELECT FROM
ref: Value.refAny =>
WITH ref.value SELECT FROM
refBool: REF READONLY BOOL => IO.bool[refBool^],
refChar: REF READONLY CHAR => IO.char[refChar^],
refCard: REF READONLY CARDINAL => IO.card[refCard^],
refLongCard: REF READONLY LONG CARDINAL => IO.card[refLongCard^],
refInteger: REF READONLY INTEGER => IO.int[refInteger^],
refInt: REF READONLY INT => IO.int[refInt^],
refNat: REF READONLY NAT => IO.int[refNat^],
refReal: REF READONLY REAL => IO.real[refReal^],
refText: REF READONLY TEXT => IO.text[refText],
ENDCASE => arg
ENDCASE => arg;
p: PFCodeProc _ pfProcs.procArray[c];
IF p = NIL THEN {
error _ PFCantBindConversionProc;  GOTO HandleError
};
p[stream, val, [format, savedFormatPointer], c ! IO.Error =>
IF ec IN [PFCantBindConversionProc .. PFUnprintableValue] THEN {
error _ ec; GOTO HandleError }];
GOTO Done;
}
}
EXITS
PutC => stream.streamProcs.putChar[stream, c];
HandleError => {
ep: PFErrorProc _ pfProcs.errorProc;
IF ep = NIL THEN ep _ PFErrorPrintPounds;
ep[error, stream];
GOTO Done;
};
} ENDLOOP;
EXITS
Done => RETURN [formatPtr];
};

ParseFormat: PROC [form: ROPE, start: INT] RETURNS [leadingMinus: BOOL _ FALSE, leadingZero: BOOL _ FALSE, fieldWidth: INTEGER _ -1, numDigits: INTEGER _ -1] = {
len: INT _ Rope.Length[form];
IF start < len THEN 
SELECT Rope.Fetch[form, start] FROM
'0 => {leadingZero _ TRUE; start _ start + 1};
'- => {leadingMinus _ TRUE; start _ start + 1};
ENDCASE;
WHILE start < len DO
c: CHAR _ Rope.Fetch[form, start];
SELECT c FROM
IN ['0..'9] => {
digit: [0..9] _ (c-'0);
IF fieldWidth < 0 THEN fieldWidth _ 0;
IF fieldWidth >= (LAST[INTEGER] - digit)/10 THEN {
fieldWidth _ LAST[INTEGER]; RETURN};
fieldWidth _ fieldWidth*10 + digit;
};
ENDCASE => EXIT;
start _ start + 1;
ENDLOOP;
IF start < len AND Rope.Fetch[form, start] = '. THEN {
start _ start + 1;
WHILE start < len DO
c: CHAR _ Rope.Fetch[form, start];
SELECT c FROM
IN ['0..'9] => {
digit: [0..9] _ (c-'0);
IF numDigits < 0 THEN numDigits _ 0;
IF numDigits >= (LAST[INTEGER] - digit)/10 THEN {
numDigits _ LAST[INTEGER]; RETURN};
numDigits _ numDigits*10 + digit;
};
ENDCASE => RETURN;
start _ start + 1;
ENDLOOP;
};
};

PFErrorPrintPounds: PUBLIC PROC [error: IO.ErrorCode, stream: STREAM] = {
PutRope[stream, "#####"];
};

PFErrorNoop: PUBLIC PROC [error: IO.ErrorCode, stream: STREAM] = {
};

PFErrorError: PUBLIC PROC [error: IO.ErrorCode, stream: STREAM] = {
ERROR IO.Error[error, stream];
};
StringRoutine: PROC [stream: STREAM, val: Value, format: Format, char: CHAR] = TRUSTED {
r: REF TEXT _ NIL;
rp: ROPE _ NIL;
WITH v: val SELECT FROM
atom => rp _ Convert.RopeFromAtom[from: v.value, quote: FALSE];
boolean => rp _ Convert.RopeFromBool[v.value];
character => {
r _ RefText.ObtainScratch[defaultTextSize];
r[0] _ v.value;
r.length _ 1;
};
cardinal => r _ Convert.AppendCard[RefText.ObtainScratch[defaultTextSize], v.value];
integer => r _ Convert.AppendInt[RefText.ObtainScratch[defaultTextSize], v.value];
real => r _ Convert.AppendG[RefText.ObtainScratch[defaultTextSize], v.value];
refAny => {
stream: STREAM = IO.ROS[];
stream.Put[val];
rp _ IO.RopeFromROS[stream];
};
rope => rp _ v.value;
text => rp _ RefText.TrustTextAsRope[v.value];
time => r _ Convert.AppendTime[
to: RefText.ObtainScratch[defaultTextSize], from: v.value, start: $years, end: $seconds];
ENDCASE => ERROR;
PrintText[r, rp, format, stream, IF char = 'h THEN TRUE ELSE FALSE];
};

FixnumRoutine: PROC [stream: STREAM, val: Value, format: Format, char: CHAR] = TRUSTED {
base: Convert.Base _ SELECT char FROM 'b => 8, 'x => 16, ENDCASE => 10;
r: REF TEXT = WITH v: val SELECT FROM
boolean => Convert.AppendCard[RefText.ObtainScratch[defaultTextSize], IF v.value THEN 1 ELSE 0, base, FALSE],
cardinal => Convert.AppendCard[RefText.ObtainScratch[defaultTextSize], v.value, base, FALSE],
integer => Convert.AppendInt[RefText.ObtainScratch[defaultTextSize], v.value, base, FALSE],
real => Convert.AppendInt[RefText.ObtainScratch[defaultTextSize], RealOps.RoundLI[v.value !
Real.RealException => ERROR IO.Error[PFUnprintableValue, stream]], base, FALSE],
ENDCASE => ERROR IO.Error[PFTypeMismatch, stream];
PrintText[r, NIL, format, stream, FALSE];
};

LooksRoutine: PROC [stream: STREAM, val: Value, format: Format, char: CHAR] = { 
WITH val SELECT FROM
ropeVal: Value.rope => {
back: STREAM _ stream.backingStream;
WHILE back # NIL DO
WITH IOUtils.LookupData[back, $SetPFCode] SELECT FROM
pfProcs: PFProcs => {
pp: PFCodeProc = pfProcs.procArray[char];
IF pp # NIL THEN {
IO.Flush[stream];
pp[back, val, format, char];
RETURN;
};
};
ENDCASE;
back _ back.backingStream;
ENDLOOP;
};
ENDCASE => ERROR IO.Error[PFTypeMismatch, stream];
};

RopeLiteralRoutine: PROC [stream: STREAM, val: Value, format: Format, char: CHAR] = {
PutEscape: PROC [c: CHAR] RETURNS [BOOL] = {
IF c IN [40C .. 177C] THEN {
IF c = '\\ OR c = '\" THEN stream.streamProcs.putChar[stream, '\\]; 
stream.streamProcs.putChar[stream, c];
}
ELSE {
stream.streamProcs.putChar[stream, '\\];
SELECT c FROM
'\n => stream.streamProcs.putChar[stream, 'n];
'\t => stream.streamProcs.putChar[stream, 't];
'\b => stream.streamProcs.putChar[stream, 'b];
'\f => stream.streamProcs.putChar[stream, 'f];
'\l => stream.streamProcs.putChar[stream, 'l];
ENDCASE => {
stream.streamProcs.putChar[stream, '0 + (c - 0C) / 64]; 
stream.streamProcs.putChar[stream, '0 + (c - 0C) MOD 64 / 8]; 
stream.streamProcs.putChar[stream, '0 + (c - 0C) MOD 8]
} ;
};
RETURN [FALSE];
};
WITH val SELECT FROM
ropeVal: Value.rope => [] _ Rope.Map[base: ropeVal.value, action: PutEscape];
ENDCASE => ERROR IO.Error[PFTypeMismatch, stream];
};

TimeIntervalRoutine: PROC [stream: STREAM, val: Value, format: Format, char: CHAR] = TRUSTED {
et, hours1, minutes, seconds: LONG CARDINAL;
li: INT;
r: REF TEXT;
han: STREAM;
WITH v: val SELECT FROM
cardinal => et _ v.value;
integer => et _ LOOPHOLE[v.value];
real => TRUSTED {
li _ RealOps.RoundLI[v.value ! Real.RealException =>
ERROR IO.Error[PFUnprintableValue, stream]];
IF li < 0 THEN ERROR IO.Error[PFUnprintableValue, stream];
et _ li;
};
ENDCASE => ERROR IO.Error[PFTypeMismatch, stream];
seconds _ et MOD 60;
et _ et/60;
minutes _ et MOD 60;
et _ et/60;
hours1 _ et MOD 100;
et _ et/100;
r _ RefText.ObtainScratch[defaultTextSize];
han _ IO.TOS[r];
IO.PutF[han, "%g%02g:%02g:%02g", 
IF et # 0 THEN IO.int[et] ELSE IO.rope[NIL],
IO.card[hours1],
IO.card[minutes],
IO.card[seconds]];
r _ han.TextFromTOS[];
han.Close[];
PrintText[r, NIL, format, stream, FALSE];
};

TimeRoutine: PROC [stream: STREAM, val: Value, format: Format, char: CHAR] = TRUSTED {
t: BasicTime.GMT;
li: INT;
WITH v: val SELECT FROM
integer => t _ BasicTime.Update[base: BasicTime.earliestGMT, period: v.value];
cardinal => t _ BasicTime.Update[base: BasicTime.earliestGMT, period: v.value];
real => {
li _ RealOps.RoundLI[v.value ! Real.RealException =>
ERROR IO.Error[PFUnprintableValue, stream]];
IF li < 0 THEN ERROR IO.Error[PFUnprintableValue, stream];
t _ BasicTime.Update[base: BasicTime.earliestGMT, period: li];
};
time => t _ v.value;
ENDCASE => ERROR IO.Error[PFTypeMismatch, stream];
PrintText[
Convert.AppendTime[
to: RefText.ObtainScratch[defaultTextSize], from: t, start: $years, end: $seconds],
NIL, format, stream, FALSE];
};

FlonumRoutine: IOUtils.PFCodeProc = {
leadingMinus: BOOL _ FALSE;
leadingZero: BOOL _ FALSE;
fieldWidth: INT _ -1;
numDigits: INT _ -1;
[leadingMinus, leadingZero, fieldWidth, numDigits] _ ParseFormat[format.form, format.first];
SELECT numDigits FROM
< 0 => numDigits _ 2;
> Real.MaxSinglePrecision => numDigits _ Real.MaxSinglePrecision;
ENDCASE;
WITH val SELECT FROM
r: real IO.Value => {
proc: PROC [REF TEXT, REAL, [0..Real.MaxSinglePrecision]] RETURNS [REF TEXT] _
SELECT char FROM
'e => Convert.AppendE, 'f => Convert.AppendF,
ENDCASE => ERROR;
scratch: REF TEXT _ RefText.ObtainScratch[defaultTextSize];
buffer: REF TEXT _ proc[scratch, r.value, numDigits];
rLen: NAT _ buffer.length;
diff: INTEGER _ fieldWidth - rLen;
IF diff > 0 AND NOT leadingMinus THEN PutChars[stream, diff, ' ];
IO.PutText[stream, buffer];
IF diff > 0 AND leadingMinus THEN PutChars[stream, diff, ' ];
RefText.ReleaseScratch[scratch];
};
ENDCASE => PutChars[stream, fieldWidth, '!];
};


PutChars: PROC [st: STREAM, chars: NAT, char: CHAR] = {
THROUGH [0..chars) DO IO.PutChar[st, char]; ENDLOOP;
};

AppendChars: PROC [text: REF TEXT, chars: NAT, char: CHAR] RETURNS [REF TEXT] = {
THROUGH [0..chars) DO text _ RefText.AppendChar[text, char]; ENDLOOP;
RETURN [text];
};

PrintText: PROC [text: REF TEXT, rp: ROPE, format: Format, stream: STREAM, visiblecc: BOOL] = {
MyPut: PROC [c: CHAR] RETURNS [BOOL] = { stream.streamProcs.putChar[stream, c]; RETURN[FALSE] };
ladj, fill0: BOOL _ FALSE;
w, k, tlength: CARDINAL;  -- w is field width, k is # chars to fill
c: CHAR;
formatPtr: INT _ format.first;
GetNextFromFormat: PROC[] = INLINE {
c _ format.form.InlineFetch[formatPtr]; formatPtr _ formatPtr.SUCC };
IF text#NIL THEN tlength _ text.length ELSE tlength _ rp.InlineLength[];
GetNextFromFormat[];
SELECT c FROM
'0 => { fill0 _ TRUE; GetNextFromFormat[] };
'- => { ladj _ TRUE; GetNextFromFormat[] };
ENDCASE;
w _ 0;
DO
SELECT c FROM
IN ['0 .. '9] => { w _ w*10 + (c - '0);  GetNextFromFormat[] };
ENDCASE => EXIT;
ENDLOOP;
SELECT Ascii.Lower[c] FROM
'., IN ['a .. 'z] => NULL;
ENDCASE => IO.Error[PFFormatSyntaxError, stream];
IF w < tlength THEN { w _ tlength; k _ 0} ELSE { k _ w - tlength };
IF NOT ladj THEN THROUGH [1..k] DO
stream.streamProcs.putChar[stream, IF fill0 THEN '0 ELSE ' ];
ENDLOOP;
IF visiblecc THEN FOR j: NAT IN [0..tlength) DO
c _ IF text#NIL THEN text[j] ELSE rp.Fetch[j];
IF c < 40C THEN {
stream.streamProcs.putChar[stream, '^];
stream.streamProcs.putChar[stream, c + LOOPHOLE['@, CARDINAL]]; }
ELSE stream.streamProcs.putChar[stream, c];
ENDLOOP
ELSE {
IF text#NIL
THEN stream.streamProcs.putBlock[stream, text, 0, text.length]
ELSE [] _ Rope.Map[base: rp, action: MyPut];
};
IF ladj THEN THROUGH [1..k] DO stream.streamProcs.putChar[stream, ' ] ENDLOOP;
IF text#NIL THEN RefText.ReleaseScratch[text];
};
Create: ENTRY PROC [] = {
globalPFProcs _ NEW[PFProcsRecord _ []];
globalPFProcs.errorProc _ PFErrorPrintPounds;
globalPFProcs.procArray['a] _ StringRoutine;
globalPFProcs.procArray['b] _ FixnumRoutine;
globalPFProcs.procArray['c] _ StringRoutine;
globalPFProcs.procArray['d] _ FixnumRoutine;
globalPFProcs.procArray['e] _ FlonumRoutine;
globalPFProcs.procArray['f] _ FlonumRoutine;
globalPFProcs.procArray['g] _ StringRoutine;
globalPFProcs.procArray['h] _ StringRoutine;
globalPFProcs.procArray['l] _ LooksRoutine;
globalPFProcs.procArray['q] _ RopeLiteralRoutine;
globalPFProcs.procArray['r] _ TimeIntervalRoutine;
globalPFProcs.procArray['s] _ StringRoutine;
globalPFProcs.procArray['t] _ TimeRoutine;
globalPFProcs.procArray['x] _ FixnumRoutine;
};

Create[];

END.

RIOPrintImpl.mesa
Copyright c 1984, 1985 by Xerox Corporation.  All rights reserved.
Schmidt on 31-Aug-81 21:39:19
Stewart on 20-Jan-82 19:15:39
Teitelman on  January 21, 1983 5:31 pm
Andrew Birrell on June 22, 1983 9:44 am
Paul Rovner on  May 26, 1983 3:56 pm
Levin on August 8, 1983 6:09 pm
MBrown on January 16, 1984 3:06 pm PST
Swinehart, June 25, 1984 1:34:33 pm PDT
Russ Atkinson (RRA) February 19, 1985 7:13:57 pm PST
TO DO:
Implement AppendReal here, eliminating ConvertReal and IeeeIOB.

RRA: It is better to quickly acquire and release buffers of constant size, even when the need is not constant, since this reduces fragmentation.  We believe that this size should be OK for nearly all applications.  It is a variable to encourage experimentation.
Put
PrintRefAny
PFProcs
PutF, PutFR, PutFL, PutFLR
PFInternal (scan format and print one Value)
Scans format, starting at formatPtr, until reaching end or reaching a conversion specification (e.g., "%05d").  If format is a null rope, treats it as if it were the rope "%g", and as if formatPtr = 0.  If conversion specification is found and arg is not null, prints it; if conversion specification is not found and arg is null, ok; otherwise error.  Returns index of first byte of format not scanned.
c is a conversion code; conversion string is the stuff between % and c.
Now either print arg or generate error.
If arg has type refAny, narrow it to a more specific type if possible.
Can't update of arg in checked code, even though arg is local!
atom: ATOM => IO.atom[atom],
rope: ROPE => IO.rope[rope],
Not possible now because of Compiler bug?
pi: REF READONLY BasicTime.GMT => time[pi^],
Not possible now because GMT is opaque
... parses a standard format specification.
leadingMinus = TRUE iff there is a '- at form[start] (and start < Length[form])
leadingZero = TRUE iff there is a '0 at form[start] (and start < Length[form])
fieldWidth is an optional leading number in the format specification
IN [0..LAST[INTEGER]) if there was a number
= -1 if there was no number present
= LAST[INTEGER] if the number overflows
numDigits is an optional number following a '. in the specification
IN [0..LAST[INTEGER]) if there was such a number
= -1 if there was no such number
= LAST[INTEGER] if said number overflows
PFCodeProcs
TRUSTED because of WITH v: val SELECT ... compiler problem
Value: any
Format: standard
char: 'h: causes ^<char> for ctrl-char.
Converts fixnums to decimal, flonums to F-format decimal.  Converts bools to "TRUE" | "FALSE".  Converts date to standard format.  Prints resulting string.
TRUSTED because of WITH v: val SELECT ... compiler problem
Value: bool, char, card, int, real
Format: standard
char: 'b: forces base 8; 'x: forces base 16
Converts numbers to decimal unless other base specified by char.  Converts bools to 1 | 0.  Converts char to numeric code.  Rounds real to nearest INT.  Prints resulting string.
Value: rope
Format: ignored
char: ignored
Noop here; for Viewer streams, performs font changes
RRA: I changed this to pass through the info to the backing stream.  This is to allow layered streams to pass along formatting commands without having to have cloned PFProcs, provided that the layered streams stuff the under layer in the backingStream field.  We stop whenever we get to a proper PFProc for the backing stream, under the assumption that it is no longer out problem after that.
Must flush stream to synch with setting looks
Value: rope
Format: ignored
char: ignored
Prints rope with \-notation for control codes, \, and "
Print c to stream with \-notation
Value: card, int, real
Format: standard
char: ignored
Rounds real to nearest INT.  Prints number as hh:mm:ss (hh may be more than two digits, but not fewer).
Value: int, card, real, time
Format: standard
char: ignored
Prints a date using AppendTime.  Interprets int, card, and real as seconds since "beginning of time"
Real Formatting
[stream: STREAM, val: IO.Value, format: IOUtils.Format, char: CHAR]
Utility routines
Field justification and filling
Prints text or rp to stream, while enforcing simple format specifications: field width, left or right justification, zero-filling.  Format has syntax [0|-|][num.num].  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.
If text is non-NIL, releases to scratch pool after call.
Initialization
สt˜
codeš
œ™Kšœ
ฯm
œ7™BKš
œ™Kš
œ™Kš
œ&™&Kš
œ'™'Kš
œ$™$Kš
œ™Kš
œ&™&K™'K™4K˜™Kš
œ?™?—K™—š
ฯk	˜	Kšœžœ	˜Kšœ
žœฯc
˜+Kš
œ˜Kšžœ
˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœžœ˜Kš
œ˜—K˜šะblœžœ
ž˜Kšžœžœ'˜LKšžœ
žœ˜Kšœž˜K˜Kšžœžœžœ
˜Kšžœžœžœ
žœ
˜Kšœžœžœ˜Kšœžœ˜Kšœžœ˜&Kšœ
žœ˜(K˜šœžœ˜Kš
œ…™…——
head™š
ฯnœžœ
žœžœžœ˜1Kšœžœ˜ šžœžœ
ž˜Kš
œX˜Xšžœ˜Kšœ	žœ
žœ*˜;Kšœžœ˜
šžœ	ž˜Kšœžœ˜ Kš
œ/˜/Kš
œ3˜3K˜K˜Kšžœ
˜—Kš
œ ˜ K˜——Kš
œ˜K˜—šกœžœ
žœžœžœ
žœ
žœ˜=Kšžœžœ
žœ1˜@Kš
œ˜—K˜šกœžœ
žœ
žœ˜8Kšœ	žœ
žœ*˜;Kš
œ˜Kš
œ˜K˜Kš
œ ˜ Kš
œ˜—K˜šกœžœ
žœ
žœ˜4Kšœ	žœ
žœ*˜;Kš
œ"˜"Kš
œ ˜ Kš
œ˜K˜—š
กœžœ
žœžœ
žœ˜4Kšœžœžœ˜Kšœ	žœ*˜;Kš
œ"˜"Kš
œ ˜ Kšžœ
žœ˜Kš
œ˜K˜—š
กœžœ
žœžœ
žœ˜8Kšœžœžœ˜Kšœ	žœ*˜;Kš
œ˜K˜K˜Kš
œ ˜ Kšžœ
žœ˜Kš
œ˜K˜—šกœžœ
žœ
žœžœ
žœ˜;Kšœ	žœ
žœ*˜;š
žœžœ
žœ
žœžœžœ
ž˜=Kš
œ$˜$Kšžœ
˜—Kš
œ ˜ Kš
œ˜—K˜šกœžœ
žœžœ
žœžœ
žœ˜;Kšœžœžœ˜Kšœ	žœ*˜;šžœžœ
žœ
žœžœž˜=Kš
œ$˜$Kšžœ
˜—Kš
œ ˜ Kšžœ
žœ˜Kš
œ˜—K˜š
ก	œžœ
žœžœ
žœ˜AKš
œ˜˜
šžœžœ
ž˜Kšœžœ
˜š
œ˜Kšœ>žœ˜F—š
œ˜Kš
œ2˜2—š
œ˜Kš
œ/˜/—š
œ˜Kšœ3žœ
žœ˜C—š
œ˜Kšœ1žœ
žœ˜A—š
œ˜Kšœ0žœ
žœ˜A—š
œ˜Kš
œ(˜(—š
œ˜Kš
œ˜—š
œ˜Kš
œ˜—š
œ˜Kš
œZ˜ZKšžœ
žœ
˜K˜—Kšžœžœ
˜—KšžœM˜RKš
œ˜—Kš
œ˜——™Kšกœžœ
˜1K˜šกœžœ
žœ/˜UKš
œ$˜$K˜—K˜šกœžœ
žœžœ˜CKšžœ˜K˜—K˜šกœžœ
žœžœ
žœžœ
žœ˜NKš
œ<˜<šžœžœ
žœ˜Kš
œ4˜4š
œ˜Kš	œžœžœ
žœžœ˜K—Kš
œ*˜*Kš
œ@˜@K˜
—šžœ˜Kšœ$žœ˜+K˜
—K˜——™Kšœ	žœžœ˜"šœž˜%Kšœžœ
žœ
žœžœ
žœ˜8Kšœž˜K˜K˜—Kšก
œžœ
˜K˜š
กœžœ
žœžœ
žœ˜=Kšžœ˜K˜K˜—š
ก
œžœ
žœžœžœ˜GKšœ
žœ)˜9Kšžœžœ
žœ˜4Kš
œ˜—K˜š
กœžœ
ž
œžœžœ˜mKš
œ˜Kšžœžœ
žœ
žœ
žœ
žœ˜@Kš
œ)˜)Kš
œ)˜)K˜—K˜šกœžœ
ž
œžœ˜eKš
œ#˜#Kš
œ$˜$K˜K˜—š
กœžœ
žœ
žœžœ˜Dš
œ˜Kšžœ
žœ
žœ
žœ
žœ
žœ)˜M—Kšžœžœ
žœ˜4Kšžœžœ˜'K˜—K˜š
ก
œžœ
žœ
žœžœ˜ZKšœžœ)˜:Kš
œ/˜/K˜—K˜š
ก
œžœ
žœžœžœ˜rKšžœžœ
žœ
žœ
žœžœ˜<Kš
œ˜Kšžœžœ
žœ
žœ
žœ
žœžœ˜@Kš
œ#˜#Kš
œ#˜#K˜—K˜šกœžœ
žœ+žœ˜jKš
žœžœ
žœ
žœ
žœ˜<Kš
œ˜Kš
œ˜K˜——™š
กœžœ
žœ
žœ
žœ ˜OKš
œ&˜&Kšœžœ˜Kšžœžœ2˜FKšžœžœ2˜FKšžœžœ2˜FKšžœžœ2˜FKšžœžœ2˜FKš
œ7˜7K˜—K˜š
กœžœ
žœ
žœ
žœ˜CKš
œ&˜&Kšœžœ˜Kšžœžœ5˜LKš
œ7˜7K˜K˜—šกœžœ
žœ
žœžœžœ˜OKšœžœžœ˜Kš
œ)˜)Kšžœžœ˜ K˜—K˜šกœžœ
žœ
žœžœžœ˜CKšœžœžœ˜Kš
œ&˜&Kšœžœ˜Kšžœžœ5˜LKš
œ7˜7Kšžœžœ˜ K˜K˜—šกœžœ
žœ
žœ
žœžœ
žœ˜JKš
œ&˜&Kšœžœ˜šžœžœ
žœ
žœžœž˜=Kš
œ6˜6Kšžœ
˜—Kš
œ7˜7Kš
œ˜—K˜šกœžœ
žœ
žœžœ
žœžœžœ˜JKšœžœžœ˜Kš
œ˜Kšžœžœ˜ Kš
œ˜——™,šก
œžœ
žœ
žœ
žœžœŸžœ˜„
Kš
œ’™’Kšœžœ˜Kšœžœ
˜šกœžœžœ˜$Kšœ9žœ
˜>Kš
œ˜—Kšœžœ˜(šžœžœ˜Kšžœžœ
žœ˜!šžœ˜Kš
œ0˜0—Kš
œ˜—šžœŸะckŸ
œ˜šžœžœ˜!Kšžœžœ
žœ˜!šžœŸ(˜/Kšœžœ˜.Kš
œ
˜
—K˜—K˜Kšžœžœ
žœ˜˜
Kšœžœ
˜$šžœ˜šžœžœŸ*˜LKšœžœ˜.Kš
œ˜—K˜Kšžœžœ
žœžœ
žœ
žœ˜6Kšžœžœ
žœ˜!š
ž˜Kšœ
žœ
˜šœŸ!˜4Kšžœ žœ
žœ
žœ˜6Kšœžœ˜.Kš
œ˜——Kšœžœ
˜
—šžœžœŸ(˜BKšœžœ˜.Kš
œ˜—Kš
œ˜š
œ
˜
Kš
œG™GK™'Kš
œF™FKš
œ>™>šœ
žœžœ
ž˜!š
œ˜šžœžœ
ž˜Kš	œ	žœ
žœ
žœžœ˜0Kš	œ	žœ
žœ
žœžœ˜0Kš	œ	žœ
žœ
žœžœ˜4Kšœ
žœ
žœ
žœ
žœžœ˜AKš	œžœ
žœ
žœžœ˜8Kš	œžœ
žœ
žœžœ˜,Kš	œžœ
žœ
žœžœ˜,Kš	œ	žœ
žœ
žœžœ˜0Kš	œ	žœ
žœ
žœžœ˜/Kš
œ™š
œ™Kš
œ)™)—š
œ,™,Kš
œ&™&—Kšžœ˜——Kšžœ˜—Kš
œ%˜%šžœžœ
žœ˜Kšœ#žœ˜3Kš
œ˜—šœ1žœ	˜<šžœžœ2žœ˜@Kšœžœ˜ ——Kšžœ˜
K˜
—K˜
—š
ž˜Kš
œ.˜.š
œ˜Kš
œ$˜$Kšžœžœ
žœ˜)K˜Kšžœ˜
K˜——Kšœžœ
˜
—š
ž˜Kšœžœ
˜—Kš
œ˜K˜—šกœžœžœ	žœžœžœžœžœžœžœžœ
˜ก
š
œ+™+Kšœžœ<™OKšœžœ<™Nš
œD™DKšžœžœ
žœ™+K™#Kšœžœ
žœ™'—š
œC™CKšžœžœ
žœ™0K™ Kšœžœ
žœ™(——Kšœžœ˜šžœ
žœ
˜šžœž˜#Kšœžœ˜.Kšœžœ˜/Kšžœ
˜——šžœ
ž˜Kšœžœ˜"šžœž˜
šžœ˜Kš
œ˜Kšžœžœ˜&šžœžœ
žœžœ˜2Kšœ
žœ
žœžœ˜$—Kš
œ#˜#Kš
œ˜—Kšžœžœ
˜—K˜Kšžœ
˜—šžœ
žœžœ˜6K˜šžœ
ž˜Kšœžœ˜"šžœž˜
šžœ˜Kš
œ˜Kšžœžœ˜$šžœžœ
žœžœ˜1Kšœžœ
žœžœ˜#—Kš
œ!˜!Kš
œ˜—Kšžœžœ
˜—K˜Kšžœ
˜—K˜—K˜K˜—šกœžœ	žœžœ˜IKš
œ˜Kš
œ˜K˜—š
กœžœ
žœ	žœžœ˜BKš
œ˜K˜—š
กœžœ
žœ	žœžœ˜CKšžœ
žœ˜Kš
œ˜——™š
ก
œžœ
žœ$žœžœ˜XKšžœžœž™:K™
K™K™'KšœNžœžœ?™›
Kšœžœ
žœžœ
˜Kšœž
œ
˜šžœžœ
ž˜Kšœ8žœ˜?Kš
œ.˜.˜Kšœ
žœ'˜+K˜K˜
K˜—Kš
œT˜TKš
œR˜RKš
œM˜Mš
œ˜Kšœžœžœ˜K˜Kšœžœ˜K˜—K˜K˜.š
œ˜Kš
œY˜Y—Kšžœžœ
˜—Kšœ!žœžœ
žœ
žœ
žœ˜DK˜K˜—š
ก
œžœ
žœ$žœžœ
˜XKšžœžœž™:K™"K™K™+KšœTž
œž
œ:žœ™ฑ
Kšœžœžœžœ˜Gšœžœ
žœžœ
ž˜%Kš	œFžœ	žœžœ
žœ˜mKšœTžœ˜]KšœTžœ˜[š
œ[˜[Kšœžœ
žœ+žœ˜P—Kšžœžœ
žœ˜2—Kšœ
žœžœ˜)K˜K˜—š	กœžœ
žœ$žœž
˜PK™K™K™
K™4šžœžœ
ž˜š
œ˜Kš
œˆ™ˆKšœžœ˜$šžœžœ
ž˜šžœ&ž˜5š
œ˜Kš
œ)˜)šžœžœ
žœ˜šžœ˜Kš
œ-™-—Kš
œ˜Kšžœ
˜K˜—K˜—Kšžœ
˜—Kš
œ˜Kšžœ
˜—Kš
œ˜—Kšžœžœ
žœ˜2—˜K˜——šกœžœ
žœ$žœ˜UK™K™K™
Kš
œ7™7š
ก	œžœžœžœžœ˜,Kš
œ!™!šžœžœžœ˜Kšžœ	žœ	žœ*˜DKš
œ&˜&K˜
—šžœ˜Kš
œ(˜(šžœž˜
Kš
œ.˜.Kš
œ.˜.Kš
œ.˜.Kš
œ.˜.Kš
œ.˜.šžœ˜Kš
œ8˜8Kšœ1žœ
˜>Kšœ1žœ˜7Kš
œ˜——K˜—Kšžœžœ˜K˜—šžœžœ
ž˜Kš
œM˜MKšžœžœ
žœ˜2—˜K˜——š
กœžœ
žœ$žœžœ˜^K™K™K™
KšœžœM™gKšœžœ
žœ
˜,Kšœžœ
˜Kšœžœ
žœ
˜Kšœžœ
˜šžœžœ
ž˜K˜Kšœžœ
˜"šœžœ˜˜4Kšžœ
žœ$˜,—Kšžœžœ
žœ
žœ#˜:K˜K˜—Kšžœžœ
žœ˜2—Kšœ
žœ˜K˜Kšœ
žœ˜K˜Kšœžœ˜K˜Kš
œ+˜+Kšœžœ˜šžœ˜!Kš
žœžœ
žœ	žœ
žœ˜,Kšžœ˜Kšžœ˜Kšžœ˜—K˜K˜Kšœ
žœžœ˜)K˜K˜—š
กœžœ
žœ$žœžœ˜VK™K™K™
Kš
œd™dKšœ
žœ
˜Kšœžœ
˜šžœžœ
ž˜Kš
œN˜NKš
œO˜O˜	˜4Kšžœ
žœ$˜,—Kš	žœžœ
žœ
žœ"ž
˜:Kš
œ>˜>K˜—K˜Kšžœžœ
žœ˜2—š
œ
˜
š
œ˜Kš
œS˜S—Kšžœžœ˜—K˜K˜——™•StartOfExpansionG -- [stream: STREAM, val: IO.Value, format: IOUtils.Format, char: CHAR]šก
œ˜%Kš
ขC™CKšœžœžœ
˜Kšœ
žœžœ
˜Kšœžœ˜Kšœžœ˜Kš
œ\˜\šžœž˜Kš
œ˜Kš
œA˜AKšžœ
˜—šžœžœ
ž˜šœžœ˜šœžœžœ
žœžœ žœžœ
žœ˜Nšžœž˜Kš
œ-˜-Kšžœžœ
˜——Kšœ	žœ
žœ*˜;Kšœžœ
žœ%˜5Kšœžœ˜Kšœžœ˜"Kšžœ
žœ
žœžœ˜AKšžœ˜Kšžœ
žœžœ˜=Kš
œ ˜ K˜—Kšžœ%˜,—K˜K˜—š
œ™K˜š
กœžœžœ	žœžœ˜7Kšžœžœ
žœžœ
˜4K˜K˜—šกœžœžœ
žœ	žœžœžœžœ
žœ˜QKšžœžœ(žœ
˜EKšžœ˜K˜K˜———™šก	œžœžœ
žœžœžœ
žœ˜_Kš
œา™าK™8Kšกœžœžœžœžœ-žœ
žœ˜`Kšœ
žœžœ
˜KšœžœŸ)˜CKšœžœ
˜Kšœžœ
˜šกœžœžœ˜$Kšœ>žœ˜E—Kšžœžœ
žœžœ˜HK˜šžœž˜
Kšœžœ˜,Kšœžœ˜+Kšžœ
˜—K˜š
ž˜šžœž˜
Kšžœ=˜?Kšžœžœ
˜—Kšžœ
˜—šžœž˜Kšœžœžœ
˜Kšžœžœ$˜1—Kšžœ
žœžœ˜Cš	žœ
žœžœ
žœž˜"Kšœ#žœžœžœ˜=Kšžœ
˜—šžœžœ
žœžœ
žœž˜/Kš	œžœžœ
žœ	žœ
˜.šžœ	žœ˜Kš
œ'˜'Kšœ'žœžœ˜A—Kšžœ'˜+Kš
ž˜—šžœ˜šžœž˜Kšžœ:˜>Kšžœ(˜,—K˜—Kš
žœžœ
žœžœ(žœ
˜NKšžœžœ
žœ˜.Kš
œ˜——™šกœž
œ˜Kšœžœ˜(Kš
œ-˜-Kš
œ,˜,Kš
œ,˜,Kš
œ,˜,Kš
œ,˜,Kš
œ,˜,Kš
œ,˜,Kš
œ,˜,Kš
œ,˜,Kš
œ+˜+Kš
œ1˜1Kš
œ2˜2Kš
œ,˜,Kš
œ*˜*Kš
œ,˜,Kš
œ˜——˜˜	K˜—Kšžœ
˜—K˜—…—Oฐ~v