-- Copyright (C) 1985, 1986 by Xerox Corporation. All rights reserved.
-- CPrintFormat.mesa
-- NFS 19-Dec-85 9:01:50
-- MEW 3-Mar-86 11:04:32
-- Routines for formatted printing in C library functions.
DIRECTORY
Ascii USING [NUL, SP],
BucketAlloc USING [Alloc, Free],
CFormatIOUtil USING [],
CIOLib USING [FilePtr, fputc],
CRuntime USING [z],
CString USING [CString, IncrBPointer, ReadChar],
DoubleIeee USING [LongDiv10],
DoubleReal USING [
Double, DoubleToPair, NumberType, SignedLongNumber, VeryLong0, VeryLongNumber],
String USING [
AppendChar, AppendCharAndGrow, AppendDecimal, AppendString, AppendSubString,
SubStringDescriptor, WordsForString];
CPrintFormat: PROGRAM
IMPORTS BucketAlloc, CIOLib, CRuntime, CString, DoubleIeee, DoubleReal, String
EXPORTS CFormatIOUtil =
{
OPEN CIOLib;
Justification: TYPE = {left, right};
SignType: TYPE = {signed, unsigned};
z: UNCOUNTED ZONE = CRuntime.z;
MyStringBody: TYPE = RECORD [length: CARDINAL, maxlength: CARDINAL];
MyString: TYPE = LONG POINTER TO MyStringBody;
FPStyle: TYPE = {e, f, g};
DoPrint: PUBLIC PROCEDURE [
iop: FilePtr, fmt: CString.CString, argp: LONG POINTER]
RETURNS [charsPrinted: INTEGER ← 0] = {
GetArg: PROCEDURE [argSize: CARDINAL] RETURNS [arg: LONG POINTER] = INLINE {
arg ← argp; argp ← argp + argSize; };
NextChar: PROCEDURE RETURNS [c: CHAR] = INLINE {
c ← CString.ReadChar[fmt];
IF c # Ascii.NUL -- prevent addr. faults -- THEN
fmt ← CString.IncrBPointer[fmt];
};
WriteC: PROCEDURE [c: CHAR] = INLINE {
ci: INTEGER ← fputc[LOOPHOLE[c], iop];
IF ci < 0 THEN ERROR OutputError;
charsPrinted ← charsPrinted.SUCC;
};
WriteChars: PROCEDURE [s: LONG STRING] = {
FOR i: CARDINAL IN [0..s.length) DO WriteC[s.text[i]]; ENDLOOP; };
WritePadding: PROCEDURE [padding: CHAR, width: CARDINAL] = {
THROUGH [0..width) DO WriteC[padding]; ENDLOOP; };
ReadNum: PROCEDURE [firstDigit: CHAR] RETURNS [num: CARDINAL, c: CHAR] = {
c ← NextChar[];
num ← firstDigit - '0;
WHILE c IN ['0..'9] DO num ← (num * 10) + (c - '0); c ← NextChar[]; ENDLOOP;
};
PrintAsNum: PROCEDURE [radix: CARDINAL, type: SignType] = {
num: CARDINAL ← LOOPHOLE[GetArg[CARDINAL.SIZE], LONG POINTER TO CARDINAL]↑;
nChars: CARDINAL;
negative: BOOLEAN = (type = signed) AND (LOOPHOLE[num, INTEGER] < 0);
s: LONG STRING;
pos: CARDINAL;
length: CARDINAL;
IF isNum2 THEN ERROR BadFormat;
IF negative THEN num ← -(LOOPHOLE[num, INTEGER]);
nChars ← BiasedLog[LONG[num], radix];
IF negative THEN nChars ← nChars + 1;
length ← String.WordsForString[MAX[fieldMin, nChars]];
s ← BucketAlloc.Alloc[length];
LOOPHOLE[s, MyString]↑ ← [length: 0, maxlength: MAX[fieldMin, nChars]];
s.length ← 0;
Fill[s, padding];
pos ← IF just = left THEN nChars - 1 ELSE s.maxlength - 1;
IF num = 0 THEN s.text[pos] ← '0
ELSE
WHILE num # 0 DO
newNum: CARDINAL ← num / radix;
s.text[pos] ← LOOPHOLE[num - (newNum * radix) + ORD['0]];
IF s.text[pos] > '9 THEN s.text[pos] ← s.text[pos] + ('A - '9) - 1;
pos ← pos - 1;
num ← newNum;
ENDLOOP;
IF negative THEN s.text[pos] ← '-;
s.length ← s.maxlength;
WriteChars[s];
BucketAlloc.Free[@s, length];
};
PrintAsLongNum: PROCEDURE [radix: CARDINAL, type: SignType] = {
num: LONG CARDINAL ← LOOPHOLE[GetArg[SIZE[LONG CARDINAL]], LONG POINTER TO
LONG CARDINAL]↑;
nChars: CARDINAL;
negative: BOOLEAN = (type = signed) AND (LOOPHOLE[num, INT] < 0);
s: LONG STRING;
pos: CARDINAL;
length: CARDINAL;
IF isNum2 THEN ERROR BadFormat;
IF negative THEN num ← -(LOOPHOLE[num, INT]);
nChars ← BiasedLog[num, radix];
IF negative THEN nChars ← nChars + 1;
length ← String.WordsForString[MAX[fieldMin, nChars]];
s ← BucketAlloc.Alloc[length];
LOOPHOLE[s, MyString]↑ ← [length: 0, maxlength: MAX[fieldMin, nChars]];
Fill[s, padding];
pos ← IF just = left THEN nChars - 1 ELSE s.maxlength - 1;
IF num = 0 THEN s.text[pos] ← '0
ELSE
WHILE num # 0 DO
newNum: LONG CARDINAL ← num / LONG[radix];
s.text[pos] ← LOOPHOLE[INTEGER[
num - (newNum * radix.LONG) + LONG[ORD['0]]]];
IF s.text[pos] > '9 THEN s.text[pos] ← s.text[pos] + ('A - '9) - 1;
pos ← pos - 1;
num ← newNum;
ENDLOOP;
IF negative THEN s.text[pos] ← '-;
s.length ← s.maxlength;
WriteChars[s];
BucketAlloc.Free[@s, length];
};
PrintAsChar: PROCEDURE = {
arg: CHAR;
s: LONG STRING;
length: CARDINAL = String.WordsForString[MAX[1, fieldMin]];
IF long OR isNum2 THEN ERROR BadFormat;
s ← BucketAlloc.Alloc[length];
LOOPHOLE[s, MyString]↑ ← [length: 0, maxlength: MAX[1, fieldMin]];
Fill[s, padding];
arg ← LOOPHOLE[GetArg[INTEGER.SIZE], LONG POINTER TO CHAR]↑;
s[IF just = left THEN 0 ELSE s.maxlength - 1] ← arg;
s.length ← s.maxlength;
WriteChars[s];
BucketAlloc.Free[@s, length];
};
PrintAsString: PROCEDURE [maxChars: CARDINAL] = {
s: LONG STRING;
arg: CString.CString;
stringLength, length: CARDINAL;
pos: CARDINAL;
IF long THEN ERROR BadFormat;
arg ← LOOPHOLE[GetArg[SIZE[LONG POINTER]], LONG POINTER TO CString.CString]↑;
stringLength ← MIN[GetStringLength[arg], maxChars];
length ← String.WordsForString[MAX[fieldMin, stringLength]];
s ← BucketAlloc.Alloc[length];
LOOPHOLE[s, MyString]↑ ← [length: 0, maxlength: MAX[fieldMin, stringLength]];
Fill[s, padding];
pos ← IF just = left THEN 0 ELSE s.maxlength - stringLength;
THROUGH [1..stringLength] DO
s.text[pos] ← CString.ReadChar[arg];
arg ← CString.IncrBPointer[arg];
pos ← pos + 1;
ENDLOOP;
s.length ← s.maxlength;
WriteChars[s];
BucketAlloc.Free[@s, length];
};
PrintAsFloat: PROCEDURE [style: FPStyle] = {
OPEN DoubleReal;
num: SignedLongNumber;
exp10: INTEGER;
type: NumberType;
precision: CARDINAL ← IF isNum2 THEN num2 ELSE 6;
arg: Double;
IF long THEN ERROR BadFormat;
arg ← LOOPHOLE[GetArg[Double.SIZE], LONG POINTER TO Double]↑;
[type: type, fr: num, exp10: exp10] ← DoubleToPair[arg, 16];
SELECT type FROM
nan => PrintNaN[];
infinity => PrintInfinity[num.sign];
normal, zero => {
intS: LONG STRING ← ReverseStringForMag[num.mag];
SELECT style FROM
e => PrintAsEFloat[intS, exp10, num.sign, precision];
f => PrintAsFFloat[intS, exp10, num.sign, precision];
g =>
IF (exp10 + LOOPHOLE[intS.length, INTEGER] - 1) IN
[-4..LOOPHOLE[precision, INTEGER]] THEN
PrintAsFFloat[intS, exp10, num.sign, precision]
ELSE PrintAsEFloat[intS, exp10, num.sign, precision];
ENDCASE;
};
ENDCASE;
};
PrintAsEFloat: PROCEDURE [
intS: LONG STRING, exp10: INTEGER, negative: BOOLEAN, precision: CARDINAL] =
{
OPEN String;
RoundUpE: PROCEDURE = {
i: CARDINAL ← printS.length - 1;
DO
SELECT printS.text[i] FROM
'9 => printS.text[i] ← '0;
IN ['0..'8] => {printS.text[i] ← printS.text[i].SUCC; EXIT; };
'. => NULL;
ENDCASE;
IF i # 0 THEN i ← i - 1
ELSE {
exp10 ← exp10.SUCC;
printS.text[IF negative THEN 1 ELSE 0] ← '1;
EXIT;
};
ENDLOOP;
};
-- PrintAsEFloat starts here.
length: CARDINAL = String.WordsForString[precision + 8]; -- longest needed.
printS: LONG STRING ← BucketAlloc.Alloc[length];
expS: LONG STRING;
expLength: CARDINAL;
extraSpace: INTEGER;
LOOPHOLE[printS, MyString]↑ ← [length: 0, maxlength: precision + 8];
IF negative THEN AppendChar[printS, '-];
AppendChar[printS, intS.text[intS.length - 1]]; -- digit left of decimal pt.
IF precision # 0 THEN String.AppendChar[printS, '.];
-- Append digits right of decimal pt.
FOR i: CARDINAL IN [1..precision] DO
IF i >= intS.length THEN AppendChar[printS, '0]
ELSE AppendChar[printS, intS.text[intS.length - 1 - i]];
ENDLOOP;
-- Round up if necessary.
IF intS.length > precision + 1
AND intS.text[intS.length - precision - 2] >= '5 THEN RoundUpE[];
exp10 ← exp10 + intS.length - 1;
AppendChar[printS, 'E];
SELECT exp10 FROM
> 0 => AppendChar[printS, '+];
< 0 => AppendChar[printS, '-];
ENDCASE => NULL;
expLength ← BiasedLog[exp10, 10];
expS ← BucketAlloc.Alloc[String.WordsForString[expLength]];
LOOPHOLE[expS, MyString]↑ ← [length: 0, maxlength: expLength];
String.AppendDecimal[s: expS, n: exp10.ABS];
AppendString[to: printS, from: expS];
extraSpace ← fieldMin - printS.length;
IF extraSpace > 0 THEN {
IF just = right THEN {
WritePadding[padding, extraSpace]; WriteChars[printS]; }
ELSE {WriteChars[printS]; WritePadding[padding, extraSpace]; }}
ELSE WriteChars[printS];
z.FREE[@intS];
BucketAlloc.Free[@printS, length];
BucketAlloc.Free[@expS, String.WordsForString[expLength]];
};
PrintAsFFloat: PROCEDURE [
intS: LONG STRING, exp10: INTEGER, negative: BOOLEAN, precision: CARDINAL] =
{
OPEN String;
RoundUpF: PROCEDURE = {
i: CARDINAL ← printS.length - 1;
DO
SELECT printS.text[i] FROM
'9 => printS.text[i] ← '0;
IN ['0..'8] => {printS.text[i] ← printS.text[i].SUCC; EXIT; };
'. => NULL;
ENDCASE;
IF i # 0 THEN i ← i.PRED
ELSE {
newS: LONG STRING ← BucketAlloc.Alloc[
String.WordsForString[printS.length + 1]];
zeros: SubStringDescriptor;
LOOPHOLE[newS, MyString]↑ ← [length: 0, maxlength: printS.length + 1];
zeros ← [
base: printS, offset: IF negative THEN 1 ELSE 0,
length: IF negative THEN printS.length - 1 ELSE printS.length];
newS.length ← 0;
IF negative THEN AppendChar[newS, '-];
AppendChar[newS, '1];
AppendSubString[to: newS, from: @zeros];
z.FREE[@printS];
printS ← newS;
EXIT;
};
ENDLOOP;
};
-- PrintAsFFloat starts here.
printS: LONG STRING ← z.NEW[StringBody [precision + 8]]; -- May need to grow.
extraSpace, intSIndex: INTEGER;
printS.length ← 0;
IF negative THEN AppendChar[printS, '-];
-- Append digits left of decimal pt.
IF -exp10 >= LOOPHOLE[intS.length, INTEGER] THEN AppendChar[printS, '0];
intSIndex ← intS.length - 1;
THROUGH [1..exp10 + intS.length] DO
IF intSIndex < 0 THEN AppendCharAndGrow[to: @printS, c: '0, z: z]
ELSE {
AppendCharAndGrow[to: @printS, c: intS.text[intSIndex], z: z];
intSIndex ← intSIndex.PRED;
};
ENDLOOP;
IF precision # 0 THEN AppendCharAndGrow[to: @printS, c: '., z: z];
-- Append digits right of decimal pt.
FOR i: INTEGER IN [0..LOOPHOLE[precision]) DO
IF intSIndex < 0 OR -(exp10 + intS.length) > i THEN
AppendCharAndGrow[to: @printS, c: '0, z: z]
ELSE {
AppendCharAndGrow[to: @printS, c: intS.text[intSIndex], z: z];
intSIndex ← intSIndex.PRED;
};
ENDLOOP;
-- Round up if necessary.
IF intSIndex >= 0 AND intS.text[intSIndex] >= '5
AND -(exp10 + intS.length) <= LOOPHOLE[precision, INTEGER] THEN RoundUpF[];
extraSpace ← fieldMin - printS.length;
IF extraSpace > 0 THEN {
IF just = right THEN {
WritePadding[padding, extraSpace]; WriteChars[printS]; }
ELSE {WriteChars[printS]; WritePadding[padding, extraSpace]; }}
ELSE WriteChars[printS];
z.FREE[@intS];
z.FREE[@printS];
};
PrintNaN: PROCEDURE = {
-- Prints asterisks to indicate attempt to print a NaN.
THROUGH [0..MAX[4, fieldMin]) DO WriteC['*]; ENDLOOP; };
PrintInfinity: PROCEDURE [negative: BOOLEAN] = {
s: LONG STRING ← BucketAlloc.Alloc[String.WordsForString[MAX[fieldMin, 2]]];
pos: CARDINAL;
LOOPHOLE[s, MyString]↑ ← [length: 0, maxlength: MAX[fieldMin, 2]];
pos ← IF just = right THEN s.maxlength - 2 ELSE 0;
Fill[s, padding];
s.text[pos] ← s.text[pos + 1] ← IF negative THEN '- ELSE '+;
s.length ← s.maxlength;
WriteChars[s];
BucketAlloc.Free[@s, String.WordsForString[MAX[fieldMin, 2]]];
};
PrintArg: PROCEDURE = {
-- Vars. isNum2, long, just, padding, and first partially determine the state.
c: CHAR ← NextChar[];
first: BOOLEAN ← TRUE;
padding ← Ascii.SP;
isNum2 ← FALSE;
just ← right;
long ← FALSE;
fieldMin ← 0;
DO
SELECT c FROM
'd => {
IF long THEN PrintAsLongNum[10, signed] ELSE PrintAsNum[10, signed];
EXIT;
};
'o => {
IF long THEN PrintAsLongNum[8, unsigned] ELSE PrintAsNum[8, signed];
EXIT;
};
'x => {
IF long THEN PrintAsLongNum[16, unsigned]
ELSE PrintAsNum[16, unsigned];
EXIT;
};
'u => {
IF long THEN PrintAsLongNum[10, unsigned]
ELSE PrintAsNum[10, unsigned];
EXIT;
};
'c => {PrintAsChar[]; EXIT; };
's => {PrintAsString[IF isNum2 THEN num2 ELSE CARDINAL.LAST]; EXIT; };
'e => {PrintAsFloat[e]; EXIT; };
'f => {PrintAsFloat[f]; EXIT; };
'g => {PrintAsFloat[g]; EXIT; };
'l => {long ← TRUE; first ← FALSE; c ← NextChar[]; };
'- => {just ← left; first ← FALSE; c ← NextChar[]; };
'. => {
IF isNum2 THEN ERROR BadFormat;
c ← NextChar[];
IF NOT c IN ['0..'9] THEN ERROR BadFormat;
isNum2 ← TRUE;
[num2, c] ← ReadNum[c];
first ← FALSE;
};
'0 => {padding ← '0; [fieldMin, c] ← ReadNum[c]; first ← FALSE; };
IN ['1..'9] => {[fieldMin, c] ← ReadNum[c]; first ← FALSE; };
ENDCASE => IF first THEN {WriteC[c]; EXIT; } ELSE ERROR BadFormat;
ENDLOOP;
};
-- DoPrint begins here.
BadFormat: ERROR = CODE;
OutputError: ERROR = CODE;
padding: CHAR;
fieldMin: CARDINAL;
long: BOOLEAN;
just: Justification;
num2: CARDINAL;
isNum2: BOOLEAN;
DO
ENABLE OutputError => {charsPrinted ← -1; EXIT; };
c: CHAR ← NextChar[];
savePos: CString.CString ← fmt;
SELECT c FROM
Ascii.NUL => EXIT;
'% => PrintArg[ ! BadFormat => {WriteC['%]; fmt ← savePos; CONTINUE}];
ENDCASE => WriteC[c];
ENDLOOP;
};
ReverseStringForMag: PROCEDURE [num: DoubleReal.VeryLongNumber]
RETURNS [digits: LONG STRING] = {
-- Creates a digit string from a VeryLongNumber with digits in reverse order.
initialLength: CARDINAL = 8;
digits ← z.NEW[StringBody [initialLength]];
digits.length ← 0;
IF num = DoubleReal.VeryLong0 THEN String.AppendChar[digits, '0];
WHILE num # DoubleReal.VeryLong0 DO
remainder: CARDINAL;
[quo: num, rem: remainder] ← DoubleIeee.LongDiv10[num];
String.AppendCharAndGrow[to: @digits, c: '0 + remainder, z: z];
ENDLOOP;
};
Fill: PROCEDURE [s: LONG STRING, padding: CHAR] = {
FOR i: CARDINAL IN [0..s.maxlength) DO s[i] ← padding; ENDLOOP; };
BiasedLog: PROCEDURE [num: LONG CARDINAL, base: CARDINAL]
RETURNS [log: CARDINAL ← 1] = {
UNTIL num < base.LONG DO num ← num / base.LONG; log ← log + 1; ENDLOOP; };
GetStringLength: PROCEDURE [s: CString.CString] RETURNS [length: CARDINAL ← 0] =
{
WHILE CString.ReadChar[s] # Ascii.NUL DO
length ← length.SUCC; s ← CString.IncrBPointer[s]; ENDLOOP;
};
}.