-- Copyright (C) 1983  by Xerox Corporation. All rights reserved. 
--File ExtendedStringImpl.mesa - to convert arbitrarily long fields to strings
--last editted by AOF 16-Feb-83 15:41:50

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

ExtendedStringImpl: PROGRAM
  IMPORTS Heap, Inline, String
  EXPORTS ExtendedString =
  BEGIN
  
  InvalidBase: PUBLIC ERROR = CODE;
  Array: TYPE = LONG POINTER TO ArraySequence;
  ArraySequence: TYPE = RECORD[SEQUENCE length: CARDINAL OF CARDINAL];
  
  ConvertToBase: PROC [
    field: LONG POINTER, size, base: CARDINAL, array: Array] =
    BEGIN
    bit, index: CARDINAL;
    Copy: TYPE = LONG POINTER TO CopySequence;
    CopySequence: TYPE = RECORD[SEQUENCE COMPUTED CARDINAL OF WORD];
    copy: Copy ← Heap.systemZone.NEW[CopySequence[size]];
    Inline.LongCOPY[field, size, copy];
    array[0] ← 0;
    FOR index IN[1..array.length) DO array[index] ← base; ENDLOOP;
    THROUGH [0..size*Environment.bitsPerWord) DO
      bit ← ShiftFieldLeft[copy, size];
      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: PROC[ptr: LONG POINTER, size: CARDINAL]
    RETURNS [lost: CARDINAL] =
  --Shift field pointed to by "ptr" and of size (words) "size" left 1 place.
  --Save the bit lost off the left end in "lost".
     BEGIN
     new: WORD ← 0;
     ptr ← ptr + size;
     THROUGH [0..size) DO
       ptr ← ptr - 1;
       lost ← Inline.BITAND[ptr↑, 100000B];  --this bit lost off left end
       ptr↑ ← Inline.BITSHIFT[ptr↑, 1];  --now shift field segment
       ptr↑ ← Inline.BITOR[ptr↑, new];  --lost on left, gained on right
       lost ← new ← Inline.BITSHIFT[lost, 1-Environment.bitsPerWord];
       ENDLOOP;
     END;
   
   AppendNumber:  PUBLIC PROC [
     field: LONG POINTER, size: CARDINAL, base: CARDINAL, string: LONG STRING] =
     BEGIN 
     array: Array;
     digit, length, index: CARDINAL;
     char: STRING ← "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"L;
     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,
       IN[16..36] => (size*Environment.bitsPerWord)/4+1,
       ENDCASE => ERROR InvalidBase;
     array ← Heap.systemZone.NEW[ArraySequence[length]];
     ConvertToBase[field, size, base, array];
     FOR index IN[0..array.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] =
     {AppendNumber[field, size, 10, string]};

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

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

  StringToNumber: PUBLIC PROC [
    field: LONG POINTER, size: CARDINAL, base: CARDINAL, string: LONG STRING] =
    BEGIN
    new: LONG CARDINAL;
    address: LONG POINTER TO CARDINAL;
    index, overflow, subfield: CARDINAL;
    FOR index: CARDINAL IN [0..size) DO
      address ← field + index; address↑ ← 0B; ENDLOOP;
    FOR index IN [0..string.length) DO
      overflow ← SELECT string[index] FROM
        IN['0..'9] => string[index] - '0,
	IN['A..'Z] => string[index] - 67C,
	ENDCASE => 0;
      FOR subfield DECREASING IN [0..size) DO
        address ← field + subfield;
        new ← LONG[address↑] * LONG[base] + LONG[overflow];
        overflow ← Inline.HighHalf[new];
        address↑ ← Inline.LowHalf[new];
	ENDLOOP;
      ENDLOOP;
    END;

  StringToDecimal: PUBLIC PROC[
    field: LONG POINTER, size: CARDINAL, string: LONG STRING] =
    {StringToNumber[field, size, 10, string]};
  
  StringToOctal: PUBLIC PROC[
    field: LONG POINTER, size: CARDINAL, string: LONG STRING] =
    {StringToNumber[field, size, 8, string]};
  
   END...