DIRECTORY
Basics USING [BITOR, BITSHIFT, LowHalf, LongDivMod, bitsPerWord, UnsafeBlock],
BasicTime USING [GMT, Now, nullGMT],
Convert USING [RopeFromTime],
IO USING [STREAM, PutBlock],
NSString USING [Character, String],
RefText USING [AppendChar, AppendRope, ObtainScratch, ReleaseScratch, TrustTextAsRope],
Rope USING [Substr, Text, ToRefText],
TTY USING [Handle, Narrow, PutText],
XFormat USING [DateFormat, ErrorCode, FormatProc, Handle, NetFormat, NumberFormat, Object, OctalFormat],
XNS;

XFormatImpl: CEDAR MONITOR
IMPORTS Basics, BasicTime, Convert, IO, RefText, Rope, TTY
EXPORTS XFormat =
BEGIN OPEN XFormat, nss: NSString;


defaultObject: Object _  [proc: NopProc, stream: NIL, data: NIL];

SetDefaultOutputSink: PUBLIC ENTRY PROC [new: Object] RETURNS [old: Object] = {
old _ defaultObject;
defaultObject _ new};

GetDefaults: ENTRY PROCEDURE RETURNS [Handle] =
{RETURN[NEW[Object _ defaultObject]]};

NopProc: FormatProc = {};


Blanks: PUBLIC PROCEDURE [h: Handle, n: CARDINAL _ 1] = {
blank: REF TEXT _ "                ";  -- 16 blanks
IF h = NIL THEN h _ GetDefaults[];
THROUGH [0..n/blank.length) DO h.proc[blank, h] ENDLOOP;
blank _ Rope.ToRefText[Rope.Substr[RefText.TrustTextAsRope[blank], 0, n MOD blank.length]];
h.proc[blank, h]};

Block: PUBLIC PROCEDURE [h: Handle, block: Basics.UnsafeBlock] = {
};

Char: PUBLIC PROCEDURE [h: Handle, char: CHAR] = {
rt: REF TEXT _ RefText.ObtainScratch[1];
rt[0] _ char; rt.length _ 1;
IF h = NIL THEN h _ GetDefaults[];
h.proc[rt, h ! UNWIND => RefText.ReleaseScratch[rt]];
RefText.ReleaseScratch[rt];
};

CR: PUBLIC PROCEDURE [h: Handle, n: CARDINAL] = {
rt: REF TEXT _ RefText.ObtainScratch[1];
rt[0] _ '\n; rt.length _ 1;
IF h = NIL THEN h _ GetDefaults[];
THROUGH [0..n) DO h.proc[rt, h ! UNWIND => RefText.ReleaseScratch[rt]] ENDLOOP;
RefText.ReleaseScratch[rt];
};

Date: PUBLIC PROCEDURE [h: Handle, time: BasicTime.GMT _ BasicTime.nullGMT,
format: DateFormat _ dateAndTime] = {
rope: Rope.Text;
IF time = BasicTime.nullGMT THEN time _ BasicTime.Now[];
SELECT format FROM
dateOnly => {rope _ Convert.RopeFromTime[from: time, start: years, end: days, includeDayOfWeek: FALSE]};
timeOnly => {rope _ Convert.RopeFromTime[from: time, start: hours, end: seconds, useAMPM: FALSE, includeZone: FALSE]};
dateAndTime => {rope _ Convert.RopeFromTime[from: time, start: years, end: seconds, useAMPM: FALSE, includeZone: FALSE]};
ENDCASE => ERROR;
IF h = NIL THEN h _ GetDefaults[];
h.proc[Rope.ToRefText[rope], h];
};

Line: PUBLIC PROCEDURE [h: Handle, r: REF TEXT, n: CARDINAL] = {
IF h = NIL THEN h _ GetDefaults[];
h.proc[r, h]; CR[h, n]};

maxDigitLength: CARDINAL = 34;

NSString: PUBLIC PROCEDURE [h: Handle, s: nss.String] = {
IF h = NIL THEN h _ GetDefaults[];
h.proc[s, h]};

NSChar: PUBLIC PROCEDURE [h: Handle, char: nss.Character] =
{Char[h, LOOPHOLE[char.code]]};

NSLine: PUBLIC PROCEDURE [h: Handle, s: nss.String, n: CARDINAL _ 1] = {
NSString[h, s]; CR[h, n]};

Number: PUBLIC PROCEDURE [h: Handle, n: LONG UNSPECIFIED, format: NumberFormat] =
BEGIN
s: REF TEXT _ RefText.ObtainScratch[maxDigitLength];
neg: BOOLEAN;
NextDigit: PROCEDURE [n: LONG CARDINAL] = {
lr: LONG CARDINAL;
r: CARDINAL;
[n, lr] _ Basics.LongDivMod[n, format.base];
IF n # 0 THEN NextDigit[n];
IF (r _ Basics.LowHalf[lr]) > 9 THEN r _ r + 'A - '0 - 10;
s _ RefText.AppendChar[s, LOOPHOLE[(r + '0).ORD]];
};
IF h = NIL THEN h _ GetDefaults[];
IF LOOPHOLE[n, LONG INTEGER] < 0 AND format.signed THEN {
n _ -LOOPHOLE[n, LONG INTEGER]; neg _ TRUE}
ELSE neg _ FALSE;
NextDigit[n];
FormatNumber[w: s, format: format, neg: neg, h: h];
RefText.ReleaseScratch[s];
END;

Octal: PUBLIC PROCEDURE [h: Handle, n: LONG CARDINAL] = {
Number[h, n, XFormat.OctalFormat];
IF n > 7 THEN Char[h, 'B]};

Reader: PUBLIC PROC [h: Handle, r: REF TEXT] = {
IF h = NIL THEN h _ GetDefaults[];
h.proc[r, h]};

ReaderBody: PUBLIC PROC [h: Handle, rb: REF TEXT] = {
IF h = NIL THEN h _ GetDefaults[];
h.proc[rb, h]};

String: PUBLIC PROC [h: Handle, s: REF TEXT] = {
IF h = NIL THEN h _ GetDefaults[];
h.proc[s, h]};

StreamProc: PUBLIC FormatProc = {
stream: IO.STREAM;
IF (stream _ NARROW[h.stream]) = NIL THEN ERROR Error[nilData];
IO.PutBlock[stream, r];
};

WriterProc: PUBLIC FormatProc = {
};

StreamObject: PUBLIC PROC [sH: IO.STREAM] RETURNS [Handle] = {
h: Handle _ NEW [Object];
IF sH = NIL THEN ERROR Error[nilData];
h.proc _ StreamProc; h.stream _ sH;
RETURN[h]};





FormatNumber: PROCEDURE [w: REF TEXT, format: NumberFormat, neg: BOOLEAN, h: Handle] = BEGIN
l: CARDINAL;
fill: REF TEXT _ (IF format.zerofill THEN "00000000" ELSE "        ");
l _ w.length + neg.ORD;
IF l < format.columns
THEN BEGIN
fillChars: CARDINAL _ format.columns - l;
IF neg AND format.zerofill THEN Char[h, '-];
THROUGH [0..fillChars/8) DO h.proc[fill, h]; ENDLOOP;
THROUGH [0..fillChars MOD 8) DO Char[h, fill[0]]; ENDLOOP;
IF neg AND ~format.zerofill THEN Char[h, '-];
END
ELSE IF neg THEN Char[h, '-];
h.proc[w, h];
END;



Error: PUBLIC ERROR [code: ErrorCode] = CODE;

bitsPerPSCharacter: CARDINAL = 2;  -- I don't want to think about the dashes
bitsPerOctalCharacter: CARDINAL = 3;
bitsPerHexCharacter: CARDINAL = 4;
minBitsPerCharacter: CARDINAL = MIN[
bitsPerPSCharacter, bitsPerOctalCharacter, bitsPerHexCharacter];

maxCharsInHostNumber: CARDINAL =
SIZE[XNS.Host]*Basics.bitsPerWord/minBitsPerCharacter + 1;
maxCharsInNetworkNumber: CARDINAL =
SIZE[XNS.Net]*Basics.bitsPerWord/minBitsPerCharacter + 1;
maxCharsInSocketNumber: CARDINAL =
SIZE[XNS.Socket]*Basics.bitsPerWord/minBitsPerCharacter + 1;
maxCharsInNetworkAddress: CARDINAL =
maxCharsInNetworkNumber + 1 + maxCharsInHostNumber + 1 + maxCharsInSocketNumber;

maxDigits: CARDINAL = MAX[
maxCharsInHostNumber, maxCharsInNetworkNumber, maxCharsInSocketNumber];
Digits: TYPE = ARRAY [0..maxDigits) OF CARDINAL;
Words: TYPE = POINTER TO ARRAY [0..3) OF WORD;

HostNumber: PUBLIC PROCEDURE [h: Handle, hostNumber: XNS.Host, format: NetFormat] = BEGIN
temp: REF TEXT _ NEW[TEXT[maxCharsInHostNumber]];
host: XNS.Host _ hostNumber;
words: Words;
IF h = NIL THEN h _ GetDefaults[];
TRUSTED { words _ LOOPHOLE[@host]; };
IF hostNumber = XNS.broadcastHost
THEN temp _ RefText.AppendChar[temp, '*]
ELSE temp _ AppendField[temp, words, SIZE[XNS.Host], format];
h.proc[temp, h];
END;

NetworkNumber: PUBLIC PROCEDURE [h: Handle, networkNumber: XNS.Net,
format: NetFormat] = BEGIN
temp: REF TEXT _ NEW[TEXT[maxCharsInHostNumber]];
net: XNS.Net _ networkNumber;
words: Words;
IF h = NIL THEN h _ GetDefaults[];
TRUSTED { words _ LOOPHOLE[@net]; };
temp _ AppendField[temp, words, SIZE[XNS.Net], format];
h.proc[temp, h];
END;

SocketNumber: PUBLIC PROCEDURE [h: Handle, socketNumber: XNS.Socket, format: NetFormat] = TRUSTED BEGIN
temp: REF TEXT _ NEW[TEXT[maxCharsInHostNumber]];
socket: XNS.Socket _ socketNumber;
words: Words;
IF h = NIL THEN h _ GetDefaults[];
TRUSTED { words _ LOOPHOLE[@socket]; };
temp _ AppendField[temp, words, SIZE[XNS.Socket], format];
h.proc[temp, h];
END;

NetworkAddress: PUBLIC PROCEDURE [h: Handle, networkAddress: XNS.Address, format: NetFormat] = TRUSTED BEGIN
temp: REF TEXT _ NEW[TEXT[maxCharsInHostNumber]];
words: Words;
IF h = NIL THEN h _ GetDefaults[];
TRUSTED { words _ LOOPHOLE[@networkAddress.net]; };
temp _ AppendField[temp, words, SIZE[XNS.Address], format];
temp _ RefText.AppendChar[temp, '.];
TRUSTED { words _ LOOPHOLE[@networkAddress.host]; };
IF networkAddress.host = XNS.broadcastHost
THEN temp _ RefText.AppendChar[temp, '*]
ELSE temp _ AppendField[temp, words, SIZE[XNS.Host], format];
temp _ RefText.AppendChar[temp, '.];
TRUSTED { words _ LOOPHOLE[@networkAddress.socket]; };
temp _ AppendField[temp, words, SIZE[XNS.Socket], format];
h.proc[temp, h];
END;


AppendField: PROC [text: REF TEXT, words: Words, count: NAT, format: NetFormat] RETURNS [REF TEXT] = {
digits: Digits;
base: NAT;
SELECT format FROM
octal => base _ 8;
productSoftware => base _ 10;
hex => base _ 16;
ENDCASE => ERROR Error[invalidFormat];
TRUSTED {
ConvertToDigits[words, count, base, @digits];
text _ AppendDigits[text, @digits, base = 10]; };
IF base = 16 THEN text _ RefText.AppendChar[text, 'H];
RETURN[text];
};

ConvertToDigits: PROC [words: Words, size, base: NAT, digits: POINTER TO Digits] = TRUSTED {
digits^ _ ALL[0];
FOR i: NAT IN [0..size*Basics.bitsPerWord) DO
bit: CARDINAL _ ShiftFieldLeft[words, size, 1];
FOR j: NAT DECREASING IN [0..maxDigits) DO
digits[j] _ digits[j]*2 + bit;
IF digits[j] >= base THEN { digits[j] _ digits[j] - base; bit _ 1; }
ELSE bit _ 0;
ENDLOOP;
ENDLOOP;
};

ShiftFieldLeft: PROC [words: Words, count: NAT, shift: INTEGER]
RETURNS [left: NAT] = TRUSTED {
right: WORD _ 0;
FOR i: NAT DECREASING IN [0..count) DO
left _ Basics.BITSHIFT[words[i], shift - 16];
words[i] _ Basics.BITOR[Basics.BITSHIFT[words[i], shift], right];
right _ left;
ENDLOOP;
};

AppendDigits: PROC [text: REF TEXT, digits: POINTER TO Digits, dashes: BOOL] RETURNS [REF TEXT] = TRUSTED {
something: BOOL _ FALSE;
FOR i: NAT IN [0..maxDigits) DO
v: NAT _ digits[i];
IF dashes AND something AND (maxDigits - i) MOD 3 = 0 THEN
text _ RefText.AppendChar[text, '-];
IF v # 0 AND ~something THEN {
IF dashes THEN {
SELECT maxDigits - i FROM
1 => text _ RefText.AppendRope[text, "0-00"];
2 => text _ RefText.AppendRope[text, "0-0"];
3 => text _ RefText.AppendRope[text, "0-"];
ENDCASE => NULL; };
IF v > 9 THEN text _ RefText.AppendChar[text, '0];  -- Leading digit for Hex case
something _ TRUE; };
IF something THEN {
c: CHAR _ IF v > 9 THEN v - 10 + 'A ELSE v + '0;
text _ RefText.AppendChar[text, c]; };
ENDLOOP;
IF ~something THEN text _ RefText.AppendChar[text, '0];
RETURN[text];
};



END.

XFormatImpl.mesa
Copyright c 1986 by Xerox Corporation.  All rights reserved.
Last Edit :26-Jun-84 18:39:36, KNguyen
Tim Diebert: December 9, 1986 2:08:29 pm PST
Public procedures
rt: REF TEXT _ NEW[TEXT[block.count]];

FOR i: INT IN [block.startIndex .. block.startIndex + block.count) DO
bp: Basics.BytePair _ IF 
rt[i - block.startIndex] _ 
rb: XS.ReaderBody _ XS.FromBlock[block];
IF h = NIL THEN h _ GetDefaults[];
h.proc[@rb, h];
FormatProc: TYPE = PROCEDURE [r: NSString.String, h: Handle];
TTYProc: PUBLIC FormatProc = {
FormatProc: TYPE = PROCEDURE [r: NSString.String, h: Handle];
tty: TTY.Handle;
IF (tty _ TTY.Narrow[h.stream]) = NIL THEN ERROR Error[nilData];
TTY.PutText[tty, r];
};

IF h.data = NIL THEN ERROR Error[nilData];
XS.AppendReader[to: h.data, from: r];
h.context _ XString.WriterInfo[h.data].endContext;
TTYObject: PUBLIC PROC [h: TTY.Handle] RETURNS [Handle] = {
handle: Handle _ NEW [Object];
IF h = NIL THEN ERROR Error[nilData];
handle.proc _ TTYProc; handle.stream _ h;
RETURN[handle]};
WriterObject: PUBLIC PROC [w: XString.Writer] RETURNS [Handle] = {
IF w = NIL THEN ERROR Error[nilData];
RETURN[[WriterProc, XString.vanillaContext, w]];
RETURN[NIL];
};
Private procedures
Network related things
This will break on a 32 bit machine.
Mainline Code
Κϋ˜
codeš
œ™Kšœ
Οm
œ1™<Kš
œ&™&K™,—K˜š
Οk	˜	Kšœžœžœžœ1˜NKšœ
žœžœ˜$Kšœžœ˜Kšžœ
žœžœ˜Kšœ	žœ˜#KšœžœJ˜WKšœžœ˜%Kšžœ
žœ˜$Kšœžœ[˜hKšžœ
˜—K˜šΟnœžœ
ž˜Kšžœžœž˜:Kšžœ
˜Kšžœ
žœ˜"K˜—˜Kšœ1žœžœ˜A—˜š
Ÿœžœ
žœ
žœžœ˜OK˜K˜——˜KšŸœžœ
ž	œ
žœ
žœ
žœ˜V—˜KšŸœ˜K˜Kš
œ™—˜šŸœžœ
ž	œžœ	˜9Kšœžœ
žœΟc˜3Kšžœžœ
žœ˜"Kšžœžœžœ
˜8KšœHžœ˜[Kš
œ˜——˜šŸœžœ
ž	œ+˜BKš	œžœ
žœžœ
žœ™&K™šžœžœ
žœ6ž™EK™Kš
œ™—Kšœžœžœ™(Kšžœžœ
žœ™"K™K˜——˜šŸœžœ
ž	œžœ˜2Kšœžœ
žœ˜(Kš
œ˜Kšžœžœ
žœ˜"Kšœžœ ˜5Kš
œ˜Kš
œ˜——˜šŸœžœ
ž	œžœ˜1Kšœžœ
žœ˜(Kš
œ˜Kšžœžœ
žœ˜"Kšžœžœžœ ž˜OKš
œ˜Kš
œ˜——˜šŸœžœ
ž	œžœ;˜qK˜Kšžœžœ˜8šžœž˜K•StartOfExpansion³
[from: 
GMT, start: 
Convert.TimePrecision _ years, end: 
Convert.TimePrecision _ minutes, includeDayOfWeek: 
BOOL _ FALSE, useAMPM: 
BOOL _ TRUE, includeZone: 
BOOL _ TRUE]šœ`žœ˜hKšœZžœžœ˜vKšœ]žœžœ˜yKšžœžœ
˜—Kšžœžœ
žœ˜"Kš
œ ˜ Kš
œ˜——˜šŸœžœ
ž	œžœ
žœžœ˜@Kšžœžœ
žœ˜"Kšœžœ˜——˜Kšœžœ˜K˜šŸœžœ
ž	œ˜9Kšžœžœ
žœ˜"Kš
œ˜——˜KšŸœžœ
ž	œ-žœ˜[—˜šŸœžœ
ž	œžœ	˜HKšœžœ˜——˜š
Ÿœžœ
ž	œžœ
žœ˜QKš
ž˜Kšœžœ
žœ)˜4Kšœžœ
˜
šŸ	œž	œžœ
žœ˜+Kšœžœ
žœ
˜Kšœžœ
˜K˜,Kšžœžœ˜Kšžœžœ˜:Kšœžœ
žœ˜2K˜—Kšžœžœ
žœ˜"šžœ
žœžœ
žœžœžœ˜9Kš	œžœžœ
žœ	žœ
˜+—Kšžœžœ
˜K˜
Kš
œ3˜3Kš
œ˜Kšžœ
˜——˜š
Ÿœžœ
ž	œžœ
žœ˜9K˜"Kšžœžœ˜——˜š
Ÿœžœ
žœžœ
žœ˜0Kšžœžœ
žœ˜"K˜——˜š
Ÿ
œžœ
žœžœ
žœ˜5Kšžœžœ
žœ˜"K˜——˜š
Ÿœžœ
žœžœ
žœ˜0Kšžœžœ
žœ˜"K˜——˜šŸ
œžœ˜!Kšœžœž	œ!™=Kšœžœ
žœ
˜Kš
žœžœžœ
žœ
žœ˜?Kšžœ˜K˜K˜—šŸœžœ™Kšœžœž	œ!™=Kšœžœ™Kš
žœžœžœ
žœ
žœ™@Kšžœ™K™K™—šŸ
œžœ˜!Kšžœ
žœ
žœ
žœ™*Kšžœ#™%K™2Kš
œ˜K˜—šŸœžœ
žœžœ
žœžœ
˜>Kšœžœ
˜Kšžœžœ
žœ
žœ˜&Kš
œ#˜#Kšžœ˜——˜š
Ÿ	œžœ
žœžœ	žœ
™;Kšœžœ
™Kšžœžœ
žœ
žœ™%Kš
œ)™)Kšžœ
™——˜šŸœžœ
žœžœ
™BKšžœžœ
žœ
žœ™%Kšžœ*™0Kšžœ
žœ™Kš
œ™——K˜˜Kš
œ™—˜šŸœž	œžœ
žœžœž˜\Kšœžœ
˜Kšœžœ
žœžœžœžœ
˜FKšœžœ
˜šžœ˜š
ž
˜
Kšœžœ˜)Kšžœžœžœ
˜,Kšžœžœžœ
˜5Kšžœžœžœžœ
˜:Kšžœžœžœ
˜-Kš
ž˜—Kšžœ
žœžœ
˜—K˜
Kšžœ
˜——K˜˜Kš
œ™—˜KšŸœžœ
žœžœ
˜-—˜Kšœžœ )˜LKšœžœ˜$Kšœžœ˜"šœžœžœ
˜$K˜@——˜šœžœ˜ Kšžœ
žœ2˜:—šœžœ˜#Kšžœ
žœ1˜9—šœžœ˜"Kšžœ
žœ4˜<—šœžœ˜$K˜P——˜šœžœžœ
˜K˜G—Kš	œžœžœžœ
žœ
˜0Kš
œžœžœ
žœ
žœžœ
žœ
˜.—˜š	Ÿ
œžœ
ž	œžœž˜YKš	œžœ
žœžœ
žœ˜1Kšœžœ˜K˜
Kšžœžœ
žœ˜"Kšžœžœ˜%šžœžœ˜!Kšžœ$˜(Kšžœ!žœ
žœ˜=—Kš
œ˜Kšžœ
˜——˜š	Ÿ
œžœ
ž	œžœž˜^Kš	œžœ
žœžœ
žœ˜1Kšœžœ˜K˜
Kšžœžœ
žœ˜"Kšžœžœ
˜$Kšœ žœ
žœ˜7Kš
œ˜Kšžœ
˜——˜šŸœžœ
ž	œžœžœ
ž˜gKš	œžœ
žœžœ
žœ˜1Kšœžœ˜"K˜
Kšžœžœ
žœ˜"Kšžœžœ
˜'Kšœ žœ
žœ˜:Kš
œ˜Kšžœ
˜——˜šŸœžœ
ž	œžœžœ
ž˜lKš	œžœ
žœžœ
žœ˜1K˜
Kšžœžœ
žœ˜"Kšžœžœ˜3Kšœ žœ
žœ˜;Kš
œ$˜$Kšžœžœ˜4šžœžœ˜*Kšžœ$˜(Kšžœ!žœ
žœ˜=—Kš
œ$˜$Kšžœžœ˜6Kšœ žœ
žœ˜:Kš
œ˜Kšžœ
˜——˜Kš
Ÿ$™$K˜šŸœžœžœ
žœžœžœžœ
žœ˜fK˜Kšœžœ
˜
šžœž˜K˜K˜K˜Kšžœžœ˜&—šžœ˜	Kš
œ-˜-Kš
œ1˜1—Kšžœžœ%˜6Kšžœ˜
K˜K˜—šŸœžœžœ
žœ
žœžœ˜\Kšœ
žœ˜šžœžœ
žœž˜-Kšœžœ"˜/š	žœžœ
ž
œ
žœž˜*K˜Kšžœžœ
ž
œ(ž
˜DKšžœ	˜
Kšžœ
˜—Kšžœ
˜—Kš
œ˜K˜—šŸœžœžœ	žœ
˜?Kšžœžœžœ˜Kšœžœ˜š	žœžœ
ž
œ
žœž˜&Kšœžœ˜-Kšœžœžœ˜AK˜
Kšžœ
˜—K˜K˜—šŸœžœžœ
žœ
žœ
žœžœžœžœ
žœžœ˜kKšœžœžœ
˜šžœžœ
žœž˜Kšœžœ
˜š	žœžœžœžœž˜:Kš
œ$˜$—Kšžœžœž˜šžœž˜Kšžœž˜š
œ-˜-Kš
œ,˜,Kš
œ+˜+Kšžœžœ˜—Kšžœžœ' ˜QKšœžœ˜—šžœž˜Kš	œžœžœžœ
žœ˜0Kš
œ&˜&—Kšžœ
˜—Kšžœžœ$˜7Kšžœ˜
K˜——K˜˜Kš
œ
™
—˜Kšžœ
˜—K˜—…—%†:‰