-- File: StringsB.Mesa  Edited by Sandman on July 1, 1980  8:40 AM
-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  InlineDefs USING [BITAND, DIVMOD],
  Mopcodes USING [zKFCB, zPOP],
  NucleusOps USING [],
  SDDefs USING [sULongDivMod],
  String USING [],
  StringDefs USING [AppendChar, AppendString, BcplMaxLength, BcplSTRING];

StringsB: PROGRAM
  IMPORTS InlineDefs, StringDefs EXPORTS NucleusOps, StringDefs, String =PUBLIC

  BEGIN OPEN StringDefs;

  Overflow: SIGNAL = CODE;
  InvalidNumber: SIGNAL = CODE;
  NUL: CHARACTER = 0C;
  Space: CHARACTER = ' ;

  UpperCase: PROCEDURE [c: CHARACTER] RETURNS [CHARACTER] =
    BEGIN IF c IN ['a..'z] THEN c _ c + ('A - 'a); RETURN[c] END;

  LowerCase: PROCEDURE [c: CHARACTER] RETURNS [CHARACTER] =
    BEGIN IF c IN ['A..'Z] THEN c _ c + ('a - 'A); RETURN[c] END;

  CompareStrings: PROCEDURE [s1, s2: STRING, ignoreCase: BOOLEAN _ TRUE]
    RETURNS [INTEGER] =
    BEGIN
    i: CARDINAL;
    l1: CARDINAL = s1.length;
    l2: CARDINAL = s2.length;
    c1, c2: CHARACTER;
    FOR i IN [0..MIN[l1, l2]) DO
      c1 _ s1[i];
      c2 _ s2[i];
      IF ignoreCase THEN BEGIN c1 _ UpperCase[c1]; c2 _ UpperCase[c2]; END;
      SELECT c1 FROM < c2 => RETURN[-1]; > c2 => RETURN[1]; ENDCASE;
      ENDLOOP;
    RETURN[SELECT l1 FROM < l2 => -1, > l2 => 1, ENDCASE => 0]
    END;

  StringToNumber: PROCEDURE [s: STRING, radix: CARDINAL]
    RETURNS [v: UNSPECIFIED] =
    BEGIN OPEN InlineDefs;
    char: CHARACTER;
    cp: CARDINAL _ 0;
    v8, v10: CARDINAL _ 0;
    neg: BOOLEAN _ FALSE;

    getchar: PROCEDURE =
      BEGIN char _ s[cp]; IF (cp _ cp + 1) > s.length THEN char _ NUL; END;

    getchar[];
    WHILE char <= Space DO
      IF char = NUL THEN SIGNAL InvalidNumber; getchar[]; ENDLOOP;
    IF char = '- THEN BEGIN neg _ TRUE; getchar[] END;
    WHILE char IN ['0..'9] DO
      v10 _ v10*10 + (char - '0); v8 _ v8*8 + (char - '0); getchar[]; ENDLOOP;
    BEGIN
    SELECT LOOPHOLE[BITAND[char, 137B], CHARACTER] FROM
      NUL => GOTO noexponent;
      'B => BEGIN v _ v8; radix _ 8; END;
      'D => BEGIN v _ v10; radix _ 10; END;
      ENDCASE => GOTO noexponent;
    getchar[];
    v10 _ 0;
    WHILE char IN ['0..'9] DO v10 _ v10*10 + char - '0; getchar[]; ENDLOOP;
    THROUGH [1..v10] DO v _ v*radix ENDLOOP;
    EXITS noexponent => v _ IF radix = 8 THEN v8 ELSE v10;
    END;
    IF char # NUL THEN SIGNAL InvalidNumber;
    IF neg THEN RETURN[-v];
    END;

  AppendNumber: PROCEDURE [s: STRING, n: CARDINAL, radix: CARDINAL] =
    BEGIN

    xn: PROCEDURE [n: CARDINAL] =
      BEGIN
      r: CARDINAL;
      [n, r] _ InlineDefs.DIVMOD[n, radix];
      IF n # 0 THEN xn[n];
      IF r > 9 THEN r _ r + 'A - '0 - 10;
      AppendChar[s, r + '0];
      END;

    xn[n];
    END;

  AppendDecimal: PROCEDURE [s: STRING, n: INTEGER] =
    BEGIN
    IF n < 0 THEN
      BEGIN
      IF n = LAST[INTEGER] THEN BEGIN AppendString[s, "-32768"L]; RETURN END;
      AppendChar[s, '-];
      n _ -n
      END;
    AppendNumber[s, n, 10];
    END;

  AppendOctal: PROCEDURE [s: STRING, n: UNSPECIFIED] =
    BEGIN AppendNumber[s, n, 8]; AppendChar[s, 'B]; END;

  AppendLongDecimal: PROCEDURE [s: STRING, n: LONG INTEGER] =
    BEGIN
    IF n < 0 THEN
      BEGIN
      IF n = LAST[LONG INTEGER] THEN
	BEGIN AppendString[s, "-2147483648"L]; RETURN END;
      AppendChar[s, '-];
      n _ -n
      END;
    AppendLongNumber[s, n, 10];
    END;

  AppendLongNumber: PROCEDURE [s: STRING, n: LONG UNSPECIFIED, radix: CARDINAL] =
    BEGIN OPEN Mopcodes;

    DivMod: PROCEDURE [n, d: LONG CARDINAL]
      RETURNS [q: LONG CARDINAL, r: INTEGER] = MACHINE CODE
      BEGIN zKFCB, SDDefs.sULongDivMod; zPOP END;

    xn: PROCEDURE [n: LONG CARDINAL] =
      BEGIN
      r: CARDINAL;
      [n, r] _ DivMod[n, radix];
      IF n # 0 THEN xn[n];
      IF r > 9 THEN r _ r + 'A - '0 - 10;
      AppendChar[s, r + '0];
      END;

    xn[n];
    END;

  StringToLongNumber: PROCEDURE [s: STRING, radix: CARDINAL]
    RETURNS [v: LONG CARDINAL] =
    BEGIN OPEN InlineDefs;
    char: CHARACTER;
    cp: CARDINAL _ 0;
    exp: CARDINAL;
    v8, v10: LONG INTEGER _ 0;
    neg: BOOLEAN _ FALSE;

    getchar: PROCEDURE =
      BEGIN char _ s[cp]; IF (cp _ cp + 1) > s.length THEN char _ NUL; END;

    getchar[];
    WHILE char <= Space DO
      IF char = NUL THEN SIGNAL InvalidNumber; getchar[]; ENDLOOP;
    IF char = '- THEN BEGIN neg _ TRUE; getchar[] END;
    WHILE char IN ['0..'9] DO
      v10 _ v10*10 + CARDINAL[char - '0];
      v8 _ v8*8 + CARDINAL[char - '0];
      getchar[];
      ENDLOOP;
    BEGIN
    SELECT LOOPHOLE[BITAND[char, 137B], CHARACTER] FROM
      NUL => GOTO noexponent;
      'B => BEGIN v _ v8; radix _ 8; END;
      'D => BEGIN v _ v10; radix _ 10; END;
      ENDCASE => GOTO noexponent;
    getchar[];
    exp _ 0;
    WHILE char IN ['0..'9] DO exp _ exp*10 + char - '0; getchar[]; ENDLOOP;
    THROUGH [1..exp] DO v _ v*radix ENDLOOP;
    EXITS noexponent => v _ IF radix = 8 THEN v8 ELSE v10;
    END;
    IF char # NUL THEN SIGNAL InvalidNumber;
    IF neg THEN RETURN[-v];
    END;

  -- routines for Bcpl strings

  BcplStringOverflow: SIGNAL = CODE;

  MesaToBcplString: PROCEDURE [s: STRING, t: POINTER TO BcplSTRING] =
    BEGIN
    i: CARDINAL;
    FOR i IN [0..(t.length _ MIN[s.length, BcplMaxLength])) DO
      t.char[i] _ s[i]; ENDLOOP;
    IF s.length > BcplMaxLength THEN SIGNAL BcplStringOverflow;
    END;

  mesaStringOverflow: SIGNAL = CODE;

  BcplToMesaString: PROCEDURE [t: POINTER TO BcplSTRING, s: STRING] =
    BEGIN
    i: CARDINAL;
    FOR i IN [0..(s.length _ MIN[t.length, s.maxlength])) DO
      s[i] _ t.char[i]; ENDLOOP;
    IF t.length > s.maxlength THEN SIGNAL mesaStringOverflow;
    END;


  END.