-- ExtendedStringImpl.mesa - edited by:
-- AOF		20-Jan-82 10:40:47
-- Poskanzer	28-Mar-83 16:40:31

DIRECTORY
  Environment USING [bitsPerWord],
  ExtendedString USING [],
  Heap USING [systemZone],
  Inline USING [BITNOT, BITSHIFT, BITAND, BITOR, LongCOPY, HighHalf, LowHalf],
  String USING [AppendChar];

ExtendedStringImpl: PROGRAM IMPORTS Heap, Inline, String EXPORTS ExtendedString
  =
  BEGIN

  InvalidBase: PUBLIC ERROR = CODE;
  InvalidNumber: PUBLIC ERROR = CODE;

  ConvertToBase: PROC [
    field: LONG POINTER, size, base: CARDINAL,
    array: LONG DESCRIPTOR FOR ARRAY OF CARDINAL] =
    BEGIN
    index: INTEGER;
    bit: CARDINAL;
    Sequence: TYPE = RECORD [SEQUENCE COMPUTED CARDINAL OF CARDINAL];
    copy: LONG POINTER ← Heap.systemZone.NEW[Sequence [size]];
    Inline.LongCOPY[field, size, copy];
    FOR index IN [1..LENGTH[array]) DO array[index] ← base; ENDLOOP;
    array[0] ← 0;
    THROUGH [0..size*Environment.bitsPerWord) DO
      bit ← ShiftFieldLeft[copy, size, 1, 0];
      FOR index ← 0, index + 1 UNTIL array[index] = base DO
        array[index] ← array[index]*2 + bit;
        IF array[index] >= base THEN
          BEGIN
          array[index] ← array[index] - base;
          bit ← 1;
          IF array[index + 1] = base THEN array[index + 1] ← 0;
          END
        ELSE bit ← 0;
        ENDLOOP;
      ENDLOOP;
    Heap.systemZone.FREE[@copy];
    END;

  ShiftFieldLeft: PROCEDURE [
    ptr: LONG POINTER, size: CARDINAL, shift: INTEGER, new: CARDINAL]
    RETURNS [lost: CARDINAL] =
    --Shift field pointed to by "ptr" and of size (words) "size" left "shift" places.
    --Save the bits lost off the left end in "lost" and add bits "new" to right end of field.
    BEGIN
    saveMask: CARDINAL = Inline.BITNOT[Inline.BITSHIFT[177777B, -shift]];
    ptr ← ptr + size;
    THROUGH [0..size) DO
      ptr ← ptr - 1;
      lost ← Inline.BITAND[ptr↑, saveMask];
      ptr↑ ← Inline.BITSHIFT[ptr↑, shift];
      ptr↑ ← Inline.BITOR[ptr↑, new];
      new ← lost ← Inline.BITSHIFT[lost, shift - Environment.bitsPerWord];
      ENDLOOP;
    END;

  AppendNumber: PUBLIC PROC [
    field: LONG POINTER, size: CARDINAL, base: CARDINAL, string: LONG STRING] =
    BEGIN
    digit, index, length: INTEGER;
    Array: TYPE = RECORD [SEQUENCE COMPUTED CARDINAL OF CARDINAL];
    array: LONG POINTER TO ARRAY OF CARDINAL;
    char: STRING ← "0123456789ABCDEF"L;
    IF
      (length ←
        SELECT base FROM
          IN [2..8) => size*Environment.bitsPerWord + 1,
          IN [8..10) => (size*Environment.bitsPerWord + 3)/3 + 1,
          IN [10..16) => size*Environment.bitsPerWord/3 + 1,
          16 => size*Environment.bitsPerWord/4 + 1,
          ENDCASE => 0) = 0 THEN ERROR InvalidBase;
    array ← LOOPHOLE[Heap.systemZone.NEW[Array [length]]];
    ConvertToBase[field, size, base, DESCRIPTOR[BASE[array↑], length]];
    FOR index IN [0..length) DO IF array[index] = base THEN EXIT; ENDLOOP;
    FOR digit DECREASING IN [0..index) DO
      String.AppendChar[string, char[array[digit]]]; ENDLOOP;
    Heap.systemZone.FREE[@array];
    END;

  AppendDecimal: PUBLIC PROC [
    field: LONG POINTER, size: CARDINAL, string: LONG STRING] =
    BEGIN AppendNumber[field, size, 10, string]; END;

  AppendOctal: PUBLIC PROC [
    field: LONG POINTER, size: CARDINAL, string: LONG STRING] =
    BEGIN AppendNumber[field, size, 8, string]; END;

  AppendHex: PUBLIC PROC [
    field: LONG POINTER, size: CARDINAL, string: LONG STRING] =
    BEGIN AppendNumber[field, size, 16, string]; END;

  StringToNumber: PUBLIC PROC [
    field: LONG POINTER, size: CARDINAL, base: CARDINAL, string: LONG STRING] =
    BEGIN
    address: LONG POINTER TO CARDINAL;
    new: LONG CARDINAL;
    overflow: CARDINAL;
    realBase: CARDINAL ← base;
    length: CARDINAL ← string.length;
    FOR index: CARDINAL IN [0..size) DO
      address ← field + index; address↑ ← 0B; ENDLOOP;
    IF length = 0 THEN ERROR InvalidNumber;
    IF string[length - 1] = 'B OR string[length - 1] = 'b THEN
      BEGIN realBase ← 8; length ← length - 1; END
    ELSE
      IF string[length - 1] = 'D OR string[length - 1] = 'd THEN
        BEGIN realBase ← 10; length ← length - 1; END
      ELSE
        IF string[length - 1] = 'H OR string[length - 1] = 'h
          OR string[length - 1] = 'X OR string[length - 1] = 'x THEN
          BEGIN realBase ← 16; length ← length - 1; END;
    FOR index: CARDINAL IN [0..length) DO
      overflow ←
        SELECT string[index] FROM
          IN ['0..'9] => string[index] - '0,
          IN ['A..'Z] => string[index] - 'A + 10,
          IN ['a..'z] => string[index] - 'a + 10,
          ENDCASE => LAST[CARDINAL];
      IF overflow >= realBase THEN ERROR InvalidNumber;
      FOR subfield: CARDINAL DECREASING IN [0..size) DO
        address ← field + subfield;
        new ← LONG[address↑]*realBase + LONG[overflow];
        overflow ← Inline.HighHalf[new];
        address↑ ← Inline.LowHalf[new];
        ENDLOOP;
      ENDLOOP;
    END;

  StringToDecimal: PUBLIC PROC [
    field: LONG POINTER, size: CARDINAL, string: LONG STRING] =
    BEGIN StringToNumber[field, size, 10, string]; END;

  StringToOctal: PUBLIC PROC [
    field: LONG POINTER, size: CARDINAL, string: LONG STRING] =
    BEGIN StringToNumber[field, size, 8, string]; END;

  END...