Power-Programmierung/CD1.mdf/pascal/library/dos/bix/longint.pas

Pascal/Delphi Source File | 1986-08-04 | 5.3 KB | 234 lines

{assorted routines for pseudo-LONGINT types in Turbo}
Program tmul;

const h:array[0..15] of char =
('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');

type long = ^byte;
     both = record case integer of
            0:(L:long);
            1:(lsw,msw:integer)
            end;
            anystring = string[255];

var i,j:integer;l:long;

function uprodii(a,b:integer):long;
{returns long product of two unsigned integers}
var r:long;
begin
 Inline($8B/$46/<a/   {mov  ax,a}
        $F7/$66/<b/   {mul  b   }
        $89/$46/<r/   {mov  r,ax}
        $89/$56/<r+2);{mov  r+2,dx}
 uprodii:=r
end;

function sprodii(a,b:integer):long;
{returns long product of two signed integers}
var r:long;
begin
 Inline($8B/$46/<a/   {mov  ax,a}
        $F7/$6E/<b/   {imul b   }
        $89/$46/<r/   {mov  r,ax}
        $89/$56/<r+2);{mov  r+2,dx}
 sprodii:=r
end;

function twos(l:long):long;
{returns 2's complement of long, i.e. reverse the sign}
var wrk:both absolute l;
    hw,lw:integer;
begin
 hw:=wrk.msw xor $ffff;
 lw:=wrk.lsw xor $ffff;
 if lw=$ffff then
 twos:=ptr(succ(hw),0) else
 twos:=ptr(hw,succ(lw))
end;

function lneg(l:long):boolean;
{returns true if long is negative}
begin lneg:=seg(l^)<0 end;

function squo(l:long;i:integer):integer;
{returns signed quotient of l div i}
var q:integer;
    neg:boolean;
begin
 neg:=i<0;
 if neg then i:=-i;
 if lneg(l) then
  begin
   neg:=not neg;
   l:=twos(l)
  end;
 Inline($8B/$46/<l/   {mov  ax,lsw of l}
        $8B/$56/<l+2/ {mov  dx,msw of l}
        $F7/$76/<i/   {idiv i}
        $89/$46/<q);  {mov  q,ax}
 if neg then squo:=-q else squo:=q
end;

function uquo(l:long;i:integer):integer;
{returns unsigned quotient of l div i}
var q:integer;
begin
 Inline($8B/$46/<l/   {mov  ax,lsw of l}
        $8B/$56/<l+2/ {mov  dx,msw of l}
        $F7/$7E/<i/   {div  i}
        $89/$46/<q);  {mov  q,ax}
 uquo:=q
end;

function srem(l:long;i:integer):integer;
{returns signed remainder of l div i}
var r:integer;
    neg:boolean;
begin
 neg:=i<0;
 if neg then i:=-i;
 if lneg(l) then
  begin
   neg:=not neg;
   l:=twos(l)
  end;
 Inline($8B/$46/<l/   {mov  ax,lsw of l}
        $8B/$56/<l+2/ {mov  dx,msw of l}
        $F7/$76/<i/   {idiv i}
        $89/$56/<r);  {mov  r,dx}
 if neg then srem:=-r else srem:=r
end;

function urem(l:long;i:integer):integer;
{returns unsigned remainder of l div i}
var r:integer;
begin
 Inline($8B/$46/<l/   {mov  ax,lsw of l}
        $8B/$56/<l+2/ {mov  dx,msw of l}
        $F7/$7E/<i/   {div  i}
        $89/$56/<r);  {mov  r,dx}
 urem:=r
end;

function ssumii(a,b:integer):long;
{returns long sum of two signed integers}
var i,j:integer;
begin
 i:=a+b;
 if (a and $8000) = (b and $8000) then
 j:=-(a shr 15) else
 j:=-(i shr 15);
 ssumii:=ptr(j,i)
end;

function usumii(a,b:integer):long;
{returns long sum of two unsigned integers}
var i,j:integer;
begin
 i:=a+b;
 j:=hi(a)+hi(b);
 if j<255 then j:=0 else
 if j>255 then j:=1 else
 j:=hi((lo(a)+lo(b)));
 usumii:=ptr(j,i)
end;

function hiword(l:long):integer;
{returns most sig word of 2-word long as integer}
begin hiword:=seg(l^) end;

function loword(l:long):integer;
{returns least sig word of 2-word long as integer}
begin loword:=ofs(l^) end;

function makel(h,l:integer):long;
{given most & least sig words (h,l), returns 2-word long}
begin makel:=ptr(h,l) end;

function prodll(one,two:long):long;
{returns the long product of two longs}
var x,y,z:both;
    a:both absolute one;
    b:both absolute two;
    neg:boolean;
begin
 neg:=lneg(a.l);
 if neg then a.l:=twos(a.l);
 if lneg(b.l) then
  begin
   neg:=not neg;
   b.l:=twos(b.l)
  end;
 x.l:=uprodii(a.lsw,b.lsw);
 y.l:=uprodii(a.lsw,b.msw);
 z.l:=uprodii(b.lsw,a.msw);
 z.l:=usumii(y.lsw,z.lsw);
 z.l:=usumii(z.lsw,x.msw);
 if neg then
 prodll:=twos(ptr(z.lsw,x.lsw))
 else
 prodll:=ptr(z.lsw,x.lsw)
end;

function i2l(i:integer):long;
{returns signed integer as long, extends the sign}
begin if i<0 then i2l:=ptr(-1,i) else i2l:=ptr(0,i) end;

function l2i(l:long):integer;
{returns 'trunc' of long, invalid if long>32767 or <-32768}
begin l2i:=ofs(l^) end;

function i2h(i:integer):anystring;
{returns 4 byte string of hex chars for integer}
begin
i2h:=h[hi(i) shr 4]+h[hi(i) and $f]+h[lo(i) shr 4]+h[i and $f]
end;

function l2r(l:long):real;
{converts long to real}
var r:real;
    neg:boolean;
begin
neg:=lneg(l);
if neg then l:=twos(l);
r := 65536.0 * Hiword(l) + Loword(l);
if loword(l)<0 then r:=r+65536.0;
if neg then r:=-r;
l2r:=r;
end;

Type longstring=string[11];

Function L2S(L:Long):LongString;
{converts long to string for printing}
var s:LongString;
begin
 STR(L2R(L):11:0,S);
 While S[1]=' ' do delete(s,1,1); {remove leading blanks}
 L2S:=S
end;

function l2h(l:long):anystring;
{returns 8 byte string of hex for long}
begin
l2h:=i2h(hiword(l))+i2h(loword(l))
end;

begin
repeat
write('#1...');readln(i);
writeln('#1=',i2h(i));
write('#2...');readln(j);
writeln('#2=',i2h(j));
l:=uprodii(i,j);
writeln('prod of 2 unsigned ints = ',l2h(l));
l:=sprodii(i,j);
writeln('prod of 2 signed ints = ',l2h(l));
l:=prodll(i2l(i),i2l(j));
writeln('prod of 2 longs = ',l2h(l));
if i<>0 then if j<>0 then
writeln('the original 2 numbers were ',squo(l,j),' and ',squo(l,i));
until i+j=0;
end.