IMPLEMENTATION MODULE Convert;

(*
        Title:          Number conversion routines.
        Author:         D.R.Lamkin.
        History:
          11 jul 84     Initial version.
          31 Jul 84     Alteration by KDR to conform to my interpretation
                        of cross language spec.
          10 Aug 84     TYPE Errors moved to Error module
          11 Aug 84     Get Errorcode etc from Errors
          30 Aug 84     Declare Procedure etc removed.
          30 Aug 84     Install System Condition Handler.
          31 Aug 84     Remove reference to Strings.
          05 Sep 84     Correction of X????ToString Results.
          24 Sep 84     New error routine  
          08 Oct 84     XSignal calls in X procs
*)

FROM Error IMPORT ErrorCode, Facility;

FROM SYSTEM IMPORT MAXCARD, MAXINT;

FROM String IMPORT CopyLC, CopyCC ;

FROM Error IMPORT ConvertFacilityErrors;


FROM Handler IMPORT  SystemSignal, InstallPANOSHandler;


VAR Buffer : ARRAY [0..35] OF CHAR;
    BufferIndex : CARDINAL;



(* ========================================================================= *)

PROCEDURE Version( VAR String : ARRAY OF CHAR ) ;
BEGIN
   CopyLC( "ConvertNumbers  0.01/12  09 Oct 84 10:13:32" , String ) ;
END Version ;

(* ------------------------------------------------------------------------- *)

PROCEDURE ConvError (error : ConvertFacilityErrors) : INTEGER;

BEGIN

RETURN ErrorCode (StrToIntFacility, ORD (error), "")

END ConvError;




(* ------------------------------------------------------------------------- *)

PROCEDURE PrintChar (number : CARDINAL) : CHAR;

(*
   Return the character corresponding to the given number.
   Assume number checked elsewhere - so dont bother checking it.
*)

VAR ch : CHAR;

BEGIN

IF (0 <= number) AND (number <= 9) THEN
   ch := CHAR (number + ORD ('0'))
ELSE
   ch := CHAR (number + ORD ('a') - 10)
END;

RETURN ch

END PrintChar;




(* ------------------------------------------------------------------------- *)

PROCEDURE PutDigits (number : CARDINAL; base : CARDINAL);
(*
   Put the number in the given base into the buffer starting
   at the current buffer index
*)

BEGIN

IF number >= base THEN
   PutDigits (number DIV base, base);
   Buffer [BufferIndex] := PrintChar (number MOD base);
   INC (BufferIndex)
ELSE
   Buffer [BufferIndex] := PrintChar (number);
   INC (BufferIndex)
END;

END PutDigits;

(* ------------------------------------------------------------------------- *)

PROCEDURE GetCard (VAR S: ARRAY OF CHAR; index: CARDINAL; VAR Number: CARDINAL)
                                                     : INTEGER;
(*
   From array S starting at index extract a cardinal
*)

VAR base      : CARDINAL;
    basefound : BOOLEAN;
    i         : CARDINAL;
    ch        : CHAR;

BEGIN

Number := 0;
base := 10;
basefound := FALSE;

LOOP
   IF index > HIGH (S) THEN
      EXIT
   END;
   ch := S [index];
   CASE ch OF
        "0".."9": i := ORD (ch) - ORD ("0")

      | "A".."Z": i := ORD (ch) - ORD ("A") + 10

      | "a".."z": i := ORD (ch) - ORD ("a") + 10

      | "_": base := Number;
             IF basefound THEN
                RETURN ConvError (BadNumberString)
             END;
             basefound := TRUE;
             IF NOT ((2 <= base) AND (base <= 36)) THEN
                RETURN ConvError (BadBase)
             END;
             i := 0;
             Number := 0
      | 0C : EXIT   (* String terminator found before end of array *)
   ELSE
      RETURN ConvError (BadNumberString)
   END;
   IF i >= base THEN
      RETURN ConvError(NumberNotInBase)
   END;
   IF ((MAXCARD-i) DIV base) < Number THEN
      RETURN ConvError (Overflow);
   END;
   Number := Number * base + i;
   INC (index)
END;

RETURN 0

END GetCard;


(* ------------------------------------------------------------------------- *)

PROCEDURE StringToInteger (VAR Number : INTEGER; VAR S : ARRAY OF CHAR)
                                                             : INTEGER;
(*
   Convert the string s to an integer.
   The string should be in the standard format, viz:
      [sign][base_][number]
*)

VAR res         : INTEGER;
    BufferIndex : CARDINAL;
    sign        : INTEGER;
    number      : CARDINAL;
BEGIN

BufferIndex := 0;
sign := +1;

(* Check for the presence of a sign *)
(* Remember what it was and strip it off *)

CASE S [BufferIndex] OF
     "+" : INC (BufferIndex)
   | "-" : sign := -1;
           INC (BufferIndex)
ELSE
END;

res := GetCard (S, BufferIndex, number);
IF res < 0 THEN
   RETURN res
END;

(* We assume that MININT = -MAXINT-1 *)

IF ((sign < 0) AND (number > (CARDINAL (MAXINT)+1))) OR
   ((sign > 0) AND (number > CARDINAL (MAXINT))) THEN
   RETURN ConvError (Overflow)
END;


Number := sign * INTEGER (number);

RETURN 0

END StringToInteger;




(* ------------------------------------------------------------------------- *)

PROCEDURE StringToCardinal (VAR Number : CARDINAL; VAR S : ARRAY OF CHAR)
                                                        : INTEGER;


VAR res         : INTEGER;
    BufferIndex : CARDINAL;

BEGIN

BufferIndex := 0;

(* Check for the presence of a sign *)
(* Remember what it was and strip it off *)

CASE S [BufferIndex] OF
     "+" : INC (BufferIndex)
   | "-" : RETURN ConvError (BadNumberString)
ELSE
END;

res := GetCard (S, BufferIndex, Number);

RETURN res


END StringToCardinal;





(* ------------------------------------------------------------------------- *)

PROCEDURE IntegerToString (VAR S : ARRAY OF CHAR; VAR Slength : CARDINAL;
                           Number : INTEGER;
                           Base : CARDINAL) : INTEGER;

BEGIN

BufferIndex := 0;

IF NOT ((2 <= Base) AND (Base <= 36)) THEN
   RETURN ConvError (BadBase)
END;

IF Number <0 THEN
   Number := - Number;
   Buffer [BufferIndex] := "-";
   INC (BufferIndex)
END;

IF Base # 10 THEN (* Prefix the number by the base *)
   PutDigits (Base, 10);
   Buffer [BufferIndex] := "_";
   INC (BufferIndex)
END;

PutDigits (Number, Base);
Buffer [BufferIndex] := 0C; (* Terminate the string *)
CopyCC (Buffer, S);
Slength := BufferIndex;

RETURN 0

END IntegerToString;




(* ------------------------------------------------------------------------- *)

PROCEDURE CardinalToString (VAR S : ARRAY OF CHAR; VAR Slength : CARDINAL;
                            Number : CARDINAL;
                            Base : CARDINAL) : INTEGER;

BEGIN

BufferIndex := 0;

IF NOT ((2 <= Base) AND (Base <= 36)) THEN
   RETURN ConvError (BadBase)
END;

IF Base # 10 THEN (* Prefix the number by the base *)
   PutDigits (Base, 10);
   Buffer [BufferIndex] := "_";
   INC (BufferIndex)
END;

PutDigits (Number, Base);
Buffer [BufferIndex] := 0C; (* Terminate the string *)
CopyCC (Buffer, S);
Slength := BufferIndex;

RETURN 0

END CardinalToString;


(* ------------------------------------------------------------------------- *)

PROCEDURE XStringToInteger (VAR S : ARRAY OF CHAR) : INTEGER;

VAR res, TheValue : INTEGER;
BEGIN

res := StringToInteger (TheValue, S);
IF res < 0 THEN
   SystemSignal(res, 2)
END;

RETURN TheValue

END XStringToInteger;




(* ------------------------------------------------------------------------- *)

PROCEDURE XStringToCardinal (VAR S : ARRAY OF CHAR): CARDINAL;

VAR res : INTEGER;
    TheValue : CARDINAL;
BEGIN

res := StringToCardinal (TheValue, S);
IF res < 0 THEN
   SystemSignal(res, 2);
END;

RETURN TheValue

END XStringToCardinal;




(* ------------------------------------------------------------------------- *)

PROCEDURE XIntegerToString (VAR S : ARRAY OF CHAR;
                            Number : INTEGER;
                            Base : CARDINAL) : CARDINAL;

VAR res : INTEGER;
    Slength : CARDINAL;
BEGIN

res := IntegerToString (S, Slength, Number, Base);
IF res < 0 THEN
   SystemSignal(res, 4) ;
END;

RETURN Slength

END XIntegerToString;




(* ------------------------------------------------------------------------- *)

PROCEDURE XCardinalToString (VAR S : ARRAY OF CHAR;
                             Number : CARDINAL;
                             Base : CARDINAL) : CARDINAL;

VAR res : INTEGER;
    Slength : CARDINAL;

BEGIN

res := CardinalToString (S, Slength, Number, Base);
IF res < 0 THEN
   SystemSignal(res, 4);
END;

RETURN Slength

END XCardinalToString;





(* ------------------------------------------------------------------------- *)

BEGIN

   InstallPANOSHandler();



END Convert.