Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/PASOCT.ZIP/PASOCT.PAS

Pascal/Delphi Source File | 1986-11-08 | 7.4 KB | 244 lines

{Some library functions to deal with octal numbers}
{Function OCT converts an integer to a string representing
the octal number. Example  x= oct(integer)
Function STR_OCT converts a string representing an octal
number to an integer. Example x = str_oct(string)}




{The following procedures help in providing some machine level
control by allowing a programmer to set specific bits in an
integer (procedure setbit) or clear specific bits in an integer
(procedure clearbit). The procedures expect two integer values
to be passed. The first integer is the integer in which to
manipulate the bit. This integer is treated as a variable
parameter. The second integer should represent the bit number
from 0 to 15 with bit 0 being the rightmost bit. A fatal error
will occur if the bit number is > 15.}

procedure setbit(var number : integer ; bit_number : integer);

  const
        bit_0 = $0001;
        bit_1 = $0002;
        bit_2 = $0004;
        bit_3 = $0008;
        bit_4 = $0010;
        bit_5 = $0020;
        bit_6 = $0040;
        bit_7 = $0080;
        bit_8 = $0100;
        bit_9 = $0200;
        bit_10 = $0400;
        bit_11 = $0800;
        bit_12 = $1000;
        bit_13 = $2000;
        bit_14 = $4000;
        bit_15 = $8000;

  var
     x : integer;

  begin
        if bit_number >= 16 then
           begin
                writeln;
                writeln('FATAL ERROR IN SETBIT PROCEDURE');
                writeln('BIT INDEX IS > 15');
                writeln('Program TERMINATING');
                halt;
           end;
    case bit_number of
         0 : x := bit_0;
         1 : x := bit_1;
         2 : x := bit_2;
         3 : x := bit_3;
         4 : x := bit_4;
         5 : x := bit_5;
         6 : x := bit_6;
         7 : x := bit_7;
         8 : x := bit_8;
         9 : x := bit_9;
         10 : x := bit_10;
         11 : x := bit_11;
         12 : x := bit_12;
         13 : x := bit_13;
         14 : x := bit_14;
         15 : x := bit_15;
         end;
    number := number and (not x);
    number := number + x;

end;

procedure clearbit(var number : integer; bit_number : integer);

  var
     x : integer;

    begin
         if bit_number >= 16 then
            begin
            writeln;
            writeln('FATAL ERROR IN CLEARBIT PROCEDURE');
            WRITELN('BIT NUMBER > 15');
            writeln('BIT NUMBER = ',bit_number);
            WRITELN('PROGRAM TERMINATING');
            END;
         case bit_number of
              0 : x := not $0001;
              1 : x := not $0002;
              2 : x := not $0004;
              3 : x := not $0008;
              4 : x := not $0010;
              5 : x := not $0020;
              6 : x := not $0040;
              7 : x := not $0080;
              8 : x := not $0100;
              9 : x := not $0200;
              10 : x := not $0400;
              11 : x := not $0800;
              12 : x := not $1000;
              13 : x := not $2000;
              14 : x := not $4000;
              15 : x := not $8000;
              end;
         number := number and x;
end;


{This function provides a means of viewing an octal representation
of an integer. The function expects an integer as input
and returns a 6 digit string which is an octal representation
of the integer.}

type
    str6 = string[6];

function oct(number : integer): str6;

    var
       result : string[6];
       x, y, bit_mask, temp1 : integer;
       subresult : char;

   begin
        result := '      ';
        bit_mask := $8000;
        x := 0;
        x := bit_mask and number;
        if x = 0 then subresult := '0'
        else subresult := '1';
        result[1] := subresult;
        bit_mask := $4000;
        for y := 1 to 5 do
            begin
                 temp1 := 0;
                 if y <> 1 then bit_mask := bit_mask div 2;
                 x := bit_mask and number;
                 if x <> 0 then setbit(temp1,2);
                 bit_mask := bit_mask div 2;
                 x := bit_mask and number;
                 if x <> 0 then setbit(temp1,1);
                 bit_mask := bit_mask div 2;
                 x := bit_mask and number;
                 if x <> 0 then setbit(temp1,0);
                 case temp1 of
                      0 : subresult := '0';
                      1 : subresult := '1';
                      2 : subresult := '2';
                      3 : subresult := '3';
                      4 : subresult := '4';
                      5 : subresult := '5';
                      6 : subresult := '6';
                      7 : subresult := '7';
                  else
                      begin
                           writeln;
                           writeln('FATAL ERROR IN OCTAL FUNCTION');
                           WRITELN('    PROGRAM TERMINATING      ');
                           HALT;
                      end;
                 end;
                 result[y+1] := subresult;
            end;
      oct := result;
end;


{function str_oct provides a means of converting a string representing}
{an octal number to be converted to an integer.                       }
{the function expects no more than a 6 character string and returns an}
{integer result. example : y := str_oct(x)  where y is an integer and }
{x is a string of no more than 6 characters representing an octal number}

type
    anystring = string[6];

function str_oct(num_string : anystring ):integer;

   var
      w , x , y , z ,str_oct1 ,most_flag : integer;
      temp1 : char;

   begin
        str_oct1 := 0;
        most_flag := 0;
        x := length(num_string);
        if x > 6 then
           begin
           writeln('Fatal ERROR in Function Str_oct');
           writeln('String length is > 6');
           writeln('String = ',num_string);
           writeln('Program Terminating');
           halt;
           end;
        if x = 6 then
           begin
           temp1 := num_string[1];
           case temp1 of
                '0' : most_flag := 0;
                '1' : setbit(most_flag,15);
                else
                    begin
                    writeln('FATAL ERROR IN STR_OCT FUNCTION');
                    WRITELN('CHARACTER 6 > 1');
                    WRITELN('NUM_STR = ', num_string);
                    WRITELN('PROGRAM TERMINATING');
                    HALT;
                    END;
              end;
           end;

     if x = 6 then w := 2 else w := 1;

     for y := w to x do
           begin
           temp1 := num_string[y];
{the following line is handy for debugging}
{writeln('y= ',y,'  temp1 = ',temp1,'  str_oct1 = ',str_oct1);}
           case temp1 of
                '0' : z := 0;
                '1' : z := 1;
                '2' : z := 2;
                '3' : z := 3;
                '4' : z := 4;
                '5' : z := 5;
                '6' : z := 6;
                '7' : z := 7;
                else
                    begin
                    writeln;
                    writeln('FATAL ERROR IN FUNCTION STR_OCT');
                    writeln('Invalid Number in string');
                    writeln('STRING = ', num_string);
                    writeln('Program TERMINATING');
                    halt;
                    end;
                end;
            str_oct1 :=(str_oct1 * 8) + z;
           end;
       str_oct := str_oct1 or most_flag;
end;