PROGRAM castwo;
 {$nomain}

{ 
  File:[22,310]CASTWO.PAS
  Author: Jim Bostwick 17-Oct-83 (From P2 CXTB)

  Last Edit: 23-JUN-1988 22:09:12 

  History:
	 23-JUN-1988 21:55:39  - JMB PA3UTL upgrade.

     Phil Hannay.  15-Jan-87.  Modified overflow handling to return a
      negative number in POS if there is overflow, and send nothing to
      terminal.  Also ignore leading zeros.

}

 {$NOLIST}
 {[a+,b+,l-,k+,r+] Pasmat }
 %INCLUDE 'PAS$EXT:General.typ';
 %INCLUDE 'PAS$EXT:Error.ext';
 {$LIST}


  PROCEDURE Castwo(VAR asc: PACKED ARRAY [lo..hi: integer] OF char;
                   VAR Bin: Word;
                   VAR pos: integer;
                   radix: integer);
    EXTERNAL;

{*USER*

 Pascal-3 procedure which converts an input string of ASCII characters in ASC
to an unsigned binary word output in BIN using the given radix input in RADIX.
POS specifies starting point in ASC on entry, and points to the
terminator character or end of ASC (whichever is encountered first) on exit. 
POS will be return as a negative value if word overflow occurs (exceeds
65535) and so this routine can be used to verify the validity of an input.
Leading space, tab and zeros are ignored.  Any non-digit following the 
first encountered digit is treated as a terminator, and of course, the upper
limit of the string in ASC will be treated as the terminator.

If the number contained in ASC contains a digit that is not valid for
the supplied RADIX value, then that digit will be treated as a "non-digit"
and thus a terminating character.  You can use this behavior to determine
if the conversion terminated earlier than expected, and thus implying that
the ascii string in ASC is not a valid number.

}
{*WIZARD*
The input string is converted to a 
bit pattern in Bin. Up to 16 characters are converted, based upon the
specified radix. Only the last n characters before the terminator are
converted, with n being determined such that integer overflow (unsigned)
cannot occur. If more characters are in the input string, they are ignored.
Leading blanks and tabs are ignored, but other leading characters
(including '+') will be treated as terminators.
Bin will always return a legitimate value, 0...65535. 
The input radix is limited to 0..10, and 16 (HEX). 

Warning - DIV operation with word exceeding 77777b (32767.) will result in
a zero for an answer.  Compares work find with words with 177777b being 
greater than 77777b.
}


  PROCEDURE Castwo;

    LABEL
      999; { used for premature exit on error }

    const
      Debug = false;

    VAR
      i, Bpos, Limit, Index, Dig: integer;
      Rad, Accum, OldAccum, Mult, oldbin, oldmult: Word;
      Maxch: char;
      Digits: SET OF char; {legal digits for selected radix}
      Overflow: boolean;

    BEGIN
      {Initialize some stuff.}
      Bin := 0;
      Rad := radix;  {need it as unsigned }
      Overflow:= false;

      { do some preliminary error checks }
      IF (radix < 2) OR (radix > 16) THEN
        BEGIN
        error(3, warning_err, 'CASTWO -- Illegal radix:', radix);
        GOTO 999
        END
      ELSE IF ((lo = 0) AND (pos < 1)) OR (pos > hi) THEN
        BEGIN
        error(4, warning_err, 'CASTWO -- Illegal postition:', pos);
        GOTO 999
        END;

      if debug then writeln('radix=',radix);
      IF radix <= 10 THEN
        BEGIN
        maxch := chr(60B - 1 + radix); {max ASCII digit for this radix}
        digits := ['0'..maxch]
        END
      ELSE
        BEGIN
        maxch := chr(ord('A') - 1 + radix);
        digits := ['0'..'9', 'A'..maxch]
        END;

      if lo = 0 then limit := ord(asc[0]) else limit := hi;

      { skip leading spaces,tabs, and zeros }
      Bpos := pos;
      while (Bpos < limit) and (ord(asc[bpos]) in [40b,11b,60b]) do
        bpos := bpos + 1;
      if ((bpos = limit) and not( asc[bpos] in digits))
	THEN         
	BEGIN  { nothing to convert }
        if debug then writeln('no bpos found');
        pos := limit;
        GOTO 999
        END;

      {Now search for the terminator character}
      index := bpos;
      while (asc[index] in digits) and (index < limit)  
      	do index := index + 1;

      { here, index is either Hi and there is no terminator (eoln),
        or index points to terminator }
      pos := index; { set return index }
      if not(asc[index] in digits) then index := index - 1;

      IF index < bpos then 
	BEGIN 	{no valid characters }
        if debug then writeln('no valid characters');
	goto 999
	END;

      if debug then 
	BEGIN 
	write('range to convert =');
	for i := bpos to index do write(asc[i]);
	writeln
	END;

      {do the conversion}
      mult := 1;
      oldbin:= 0;
      oldmult:= 0;
      WHILE (Index >= Bpos) DO
        BEGIN
        IF asc[Index] IN ['A'..'F'] THEN
          DIG := (ord(asc[Index]) - 67B)
        ELSE DIG := (ord(asc[Index]) - 60B);
        if debug then
	  writeln('index =',index,' mult =', mult:-6, ' this digit=',
	  	dig:1, ' bin before add=', bin:-6);
        accum:= 0;
        oldaccum:= 0;
        while not(overflow) and (dig > 0) do
           begin
           accum:=accum+mult;
           if accum < oldaccum
             then begin
               if debug then writeln('overflow in accum');
               overflow:=true
               end
             else begin
               oldaccum:= accum;
               dig:= dig - 1;
               end;
           end;
        if not(overflow)
          then begin
            bin:= bin + accum;
            if debug then
    	  writeln('oldbin=',oldbin:-6,' bin after add=',bin:-6);
            if bin < oldbin
              then begin
                { overflow occurred}
                if debug then writeln('overflow in bin after adding dig');
                overflow:= true;
                end
              else begin
                { go to next digit }
                oldbin:= bin;
                index := index - 1;
                if index >= bpos
                  then begin
                  { compute next multiplier - we must add rather that use 
                   multiply since we may not detect overflow if we multiply.} 
                  i:= radix;
                  accum:= mult;
                  oldaccum:= mult;
                  while not(overflow) and (i>1) do
                    begin
                    accum:=accum+mult;
                    if accum < oldaccum
                      then begin
                        if debug then writeln('overflow in mult');
                        overflow:=true
                        end
                      else begin
                        oldaccum:= accum;
                        i:= i - 1;
                        end;
                    end;
                if not(overflow) then mult:= accum;
                end;
              end;
            end;
        If overflow
          then BEGIN
          { overflow - make POS negative }
          pos:= pos * (-1);
          if debug then writeln ('overflow occurred, pos=',pos:1);
          GOTO 999 {force termination rather than overflow}
          END;
        END;
    999:
    END;