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


  }.