Early Demonstration of Long Integers 
Author Message
 Early Demonstration of Long Integers

Hi all, found this program a while ago, just knocked up a basic
demonstration of how it works now (simply adds a long integer up). It has no
real use under Turbo Pascal 4 or up (for obvious reasons), but for TP 3.x,
it's an interesting demonstration of using Long Integers in it.

With Regards,
Ross.
---------------------------- Long3x.PAS ----------------------------------
{
  Long integer arithmatic package:
  This set of subroutines allow you to compute with integers in the
  range of +2,147,483,647 to -2,147,483,648.

  Long integers are stored as four bytes (or two words) and are defined by
  the long type.

  Long integers can be initialized either from a string with optionally
  a sign and one to ten digits via the routine atol.  The string must be
  of type longstr.

  Further, the routine itol allows you to initialize a long from
  an integer.

  Finally, some DOS functions return long integers.

  Long integers are converted to strings for display via the ltoa routine.
  It returns a string with the type of longstr.

  Performance testing indicates that these routines are typically
  70% faster and require half the memory as equivilent functions
  coded directly in TURBO Pascal.

  See listings for calling details.

Quote:
}

{;                                                               }
{; Copyright (c) 1984 Thomas J. Foth                             }
{; All Rights Reserved                                           }
{;                                                               }
{; Permission is granted to freely distribute this code, but not for}
{; profit and provided that the following address and disclaimer are}
{; included.                                                     }
{;                                                               }
{; Portions of this program may be used freely, in other works, provided}
{; that credit to the author and this work appear with the portions used.}
{;                                                                }
{; The author's address:                                          }
{;                                                                }
{; Thomas J. Foth                                                 }
{; 260 Sunset Ave.                                                }
{; Fairfield, CT 06430                                            }
{; (203) 334-6401                                                 }
{;                                                                }
{; Disclaimer:                                                    }
{;                                                                }
{; This program is provided "as-is" without warranty of any kind, either}
{; expressed or implied, including, but not limited to the implied}
{; warranties of merchantability and fitness for a particular purpose.}
{;                                                                }

type long = record
             loword : integer;
             hiword : integer;
            end;
     longstr = string[11];

procedure itol(n1:integer;var n2:long);
{ Convert signed to integer n1 to signed long n2 }
 begin;
  n2.loword := n1;
  if n1 >= 0 then n2.hiword := 0
             else n2.hiword := -1;
 end;

procedure addl(var sum:long;n1,n2:long);
{ Add long n1 to n2 producing sum: may be treated as signed }
{ or unsigned                                      }
 Begin;
  inline
   ($8B/$86/>n1/         { MOV AX,n1[bp]    }
    $03/$86/>n2/         { ADD AX,n2[bp]    }
    $C4/$BE/>sum/        { LES DI,sum[BP]   }
    $26/$89/$05/         { MOV ES:[DI],AX   }
    $BF/$02/$00/         { MOV DI,2}
    $8B/$83/>n1/         { MOV AX,n1[di+bp] }
    $13/$83/>n2/         { ADC AX,n2[di+bp] }
    $C4/$BE/>sum/        { LES DI,sum[BP]   }
    $26/$89/$45/$02);    { MOV ES:[DI]+2,AX }
 end;

procedure subl(var diff:long;n1,n2:long);
{ subtract long n2 from n1 producing diff:
{may be treated as signed or unsigned}
 Begin;
  inline
   ($8B/$86/>n1/         { MOV AX,n1[bp]    }
    $2B/$86/>n2/         { SUB AX,n2[bp]    }
    $C4/$BE/>diff/       { LES DI,diff[BP]  }
    $26/$89/$05/         { MOV ES:[DI],AX   }
    $BF/$02/$00/         { MOV DI,2}
    $8B/$83/>n1/         { MOV AX,n1[di+bp] }
    $1B/$83/>n2/         { SBB AX,n2[di+bp] }
    $C4/$BE/>diff/       { LES DI,diff[BP]  }
    $26/$89/$45/$02);    { MOV ES:[DI]+2,AX }
 end;

function cmpl(n1: long; op:longstr; n2:long): boolean;

{ compares long n1 with n2 returning boolean:}
{may be treated as signed }
{ or unsigned. op is a string like   }
{'>', '<', '=>', '=<', '>=', '<=',   }
{ or '='.  '<>' is NOT supported: use}
{NOT(cmpl(n1,'=',n2)) instead.    }
 var bool: boolean;
 Begin;
  inline (
    $8B/$86/>n1/         { MOV AX,n1[bp]    }
    $2B/$86/>n2/         { SUB AX,n2[bp]    low order word difference}
    $BF/$02/$00/         { MOV DI,2         point to high order words}
    $8B/$9B/>n1/         { MOV BX,n1[di+bp] }
    $1B/$9B/>n2/         { SBB BX,n2[di+bp] high order word difference}
    $30/$ED/             { XOR CH,CH        }
    $8A/$8E/>op/         { MOV CL,op[bp]    get the string length}
    $8D/$B6/>op/         { LEA SI,op[bp]    }
    $46/                 { INC SI           point to the first operator}
    $C6/$86/>bool/$00/   { MOV bool[bp],false assume false}
    $E3/$36/             { jcxz exit        no opeators: false}
                         { tstops: }
    $36/$80/$3C/$3D/     { cmp byte ptr ss:[si],'='}
    $75/$0A/             { jne opt1         not an equal sign}
    $09/$DB/             { or  bx,bx        }
    $75/$22/             { jnz nxtop        not zero: can't be true}
    $09/$C0/             { or  ax,ax        }
    $75/$1E/             { jnz nxtop        not zero: can't be true}
    $EB/$21/             { jmp true         hi & lo zero: true     }
                         { opt1:   }
    $36/$80/$3C/$3E/     { cmp byte ptr ss:[si],'>'}
    $75/$0C/             { jne  opt2        not a greater than sign}
    $09/$DB/             { or   bx,bx       }
    $78/$12/       { js   nxtop       neg. difference means less than}
    $75/$15/    { jnz  true        pos. difference means greater than}
    $09/$C0/             { or   ax,ax       }
    $75/$11/      { jnz  true        pos. difference means greater than}
    $EB/$0A/             { jmp  nxtop       no difference means equal}
                         { opt2:   }
    $36/$80/$3C/$3C/     { cmp byte ptr ss:[si],'<'}
    $75/$0E/             { jne  exit        invalid operator is false}
    $09/$DB/             { or   Bx,Bx       }
    $78/$05/        { js   true        neg. difference means less than}
                         { nxtop:  }
    $46/                 { INC SI           point to next operator}
    $E2/$D1/   { LOOP tstops      test until true or no more operators}
    $EB/$05/             { JMP  EXIT        true not found: exit false}
                         { true:   }
    $C6/$86/>bool/$01);  { MOV  bool[bp],true set true}
                         { exit:   }
    cmpl:=bool;
 end;

procedure divl(var quo,rem:integer;n1:long;n2:integer);
{ Divides signed integer n2 into signed long n2, yielding signed    }
{ integer quotient quo and signed integer remainder rem    }
 Begin;
  inline
   ($8B/$86/>n1/         { MOV AX,n1[bp]    }
    $BF/$02/$00/         { MOV DI,2}
    $8B/$93/>n1/         { MOV DX,n1[bp+di] }
    $8B/$8E/>n2/         { MOV CX,n2[bp]    }
    $F7/$F9/             { IDIV CX }
    $C4/$BE/>quo/        { LES DI,quo[bp]   }
    $26/$89/$05/         { MOV ES:[DI],AX   }
    $C4/$BE/>rem/        { LES DI,rem[bp]   }
    $26/$89/$15);        { MOV ES:[DI],DX   }
 end;

procedure multl(var prod:long;n1,n2:integer);
{ Multiplies signed integer n2 by signed integer n2, producing signed }
{ long prod.                                                 }
 Begin;
  inline
   ($8B/$86/>n1/         { MOV AX,n1[bp]    }
    $8B/$8E/>n2/         { MOV CX,n2[bp]    }
    $F7/$E9/             { IMUL CX }
    $C4/$BE/>prod/       { LES DI,prod[bp]  }
    $26/$89/$05/         { MOV ES:[DI],AX   }
    $26/$89/$55/$02);    { MOV ES:[DI+2],DX }
 end;

procedure slrl(var quo:long;shift:integer);
{ Shifts quo by number of bits in 'shift' right, filling vacated bits }
{ left with zeros.                                           }
 Begin;
  inline (
    $cd/$02/
    $8B/$8E/>shift/      { MOV CX,shift[bp] }
    $09/$C9/             { OR  CX,CX        }
    $74/$18/             { JZ  END }
    $C4/$BE/>quo/        { LES DI,quo[bp]   }
    $26/$8B/$05/         { MOV AX,ES:[DI]   }
    $26/$8B/$55/$02/     { MOV DX,ES:[DI+2] }
    $D1/$EA/             { SHIFT: SHR DX    }
    $D1/$D8/             { RCR AX  }
    $E2/$FA/             { LOOP SHIFT       }
    $26/$89/$05/         { MOV ES:[DI],AX   }
    $26/$89/$55/$02);    { MOV ES:[DI+2],DX }
                         { END:    }
 end;

procedure sarl(var quo:long;shift:integer);
{ Shifts long by number fo bits in 'shift' right, propagating the sign bit.}
 Begin;
  inline (
    $cd/$02/
    $8B/$8E/>shift/      { MOV CX,shift[bp] }
    $09/$C9/             { OR  CX,CX        }
    $74/$18/             { JZ  END }
    $C4/$BE/>quo/        { LES DI,quo[bp]   }
    $26/$8B/$05/         { MOV AX,ES:[DI]   }
    $26/$8B/$55/$02/     { MOV DX,ES:[DI+2] }
    $D1/$FA/             { SHIFT: SAR DX    }
    $D1/$D8/             { RCR AX  }
    $E2/$FA/             { LOOP SHIFT       }
    $26/$89/$05/         { MOV ES:[DI],AX   }
    $26/$89/$55/$02);    { MOV ES:[DI+2],DX }
                         { END:    }
 end;

procedure slll(var quo:long;shift:integer);
{ Shifts long by number fo bits in 'shift' left, filling vacated}
{bits on right with zeros.}
 Begin;
  inline (
    $cd/$02/
    $8B/$8E/>shift/      { MOV CX,shift[bp] }
    $09/$C9/             { OR  CX,CX        }
    $74/$18/             { JZ  END }
    $C4/$BE/>quo/        { LES DI,quo[bp]   }
    $26/$8B/$05/         { MOV AX,ES:[DI]   }
    $26/$8B/$55/$02/     { MOV DX,ES:[DI+2] }
    $D1/$E0/             { SHIFT: SHL AX    }
    $D1/$D2/             { RCL DX  }
    $E2/$FA/             { LOOP SHIFT       }
    $26/$89/$05/         { MOV ES:[DI],AX   }
    $26/$89/$55/$02);    { MOV ES:[DI+2],DX }
                         { END:    }
 end;

function ltoa(long:long): longstr;
{ Converts a long to signed printable ASCII string }
 var temps :array[1..5] of char;
     strg  :longstr;
 Begin;
  inline(
 $1E/              {         PUSH    DS                             }
 $FC/              {CLD                    Set direction Forward    }
 $8C/$D0/          {         MOV     AX,SS                          }
 $8E/$C0/          {         MOV     ES,AX                          }
 $8E/$D8/          {         MOV     DS,AX                          }
 $32/$C0/          {         XOR     AL,AL          Clear AX        }
 $8D/$BE/temps/    {   LEA     DI,TEMPS[BP]Point to working storage }
 $B9/$05/$00/      {         MOV     CX,5           Five bytes      }
 $AA/              {CLEAR:   STOS    BYTE PTR [DI]Clear temp variables}
 $E2/$FD/          {         LOOP    CLEAR           -all of them   }
 $B9/$20/$00/      {         MOV     CX,32    bits to convert       }
 $8B/$9E/>long/    {   MOV     BX,LONG[BP] Load low order word      }
 $BF/$02/$00/      {         MOV     DI,2           ... and ...     }
 $8B/$93/>long/    {         MOV     DX,LONG[BP+DI] hi order word   }
 $F7/$C2/$00/$80/  {         TEST    DX,$8000       Negative?       }
 $74/$0A/          {         JZ      NOCOMP         Nope            }
 $F7/$D2/          {         NOT     DX             1's Complement  }
 $F7/$D3/          {         NOT     BX             Both            }
 $83/$C3/$01/      {         ADD     BX,1           Add 1           }
 $83/$D2/$00/      {         ADC     DX,0           Carry over      }
 $FD/              {NOCOMP:  STD           Set direction backward   }
 $51/              {BITLOOP: PUSH    CX             Save bit counter}
 $B9/$05/$00/      {         MOV     CX,5  Five bytes = ten digits  }
 $8D/$B6/temps/    {         LEA     SI,TEMPS[BP]   Set Indices     }
 $83/$C6/$04/      {         ADD     SI,4           -end of ws      }
 $8B/$FE/          {         MOV     DI,SI                          }
 $D1/$E3/          {         SHL     BX,1           Get a Bit       }
 $D1/$D2/          {         RCL     DX,1  Rotate through all bits  }
 $AC/              {BITADD:  LODSB                  Get a byte      }
 $12/$C0/          {         ADC     AL,AL Double adding in carry   }
 $27/              {         DAA                    Packed adjust   }
 $AA/              {         STOSB                  Save it         }
 $E2/$F9/          {        LOOP    BITADD for another two digits   }
 $59/              {         POP     CX             get bit counter }
 $E2/$E5/          {         LOOP    BITLOOP        another bit     }
 $FC/              {         CLD                    Go forward      }
 $8D/$BE/strg/     {         LEA     DI,strg[bp]    Point to string }
 $47/              {         INC     DI    Point to character       }
 $33/$D2/          {         XOR     DX,DX Clear DX - length counter}
 $BE/$02/$00/      {         MOV     SI,2  Offset to hi order       }
 $F7/$82/>long/    {         TEST    LONG[BP+SI],8000  Negative?    }
 $00/$80/
 $74/$04/          {         JZ      NOSIGNED       Nope            }
 $42/              {         INC     DX             Set length      }
 $B0/$2D/          {         MOV     AL,'-'         Make it minus   }
 $AA/              {         STOSB                  save it         }
 $8D/$B6/temps/    {UNSIGNED:LEA     SI,TEMPS[BP]Point to working storage}
 $B9/$0A/$00/      {         MOV     CX,10          Ten bytes       }
 $33/$DB/          {         XOR     BX,BX Clear BX - length counter}
 $F7/$C1/$01/$00/  {UNPK:    TEST    CX,1           High order?     }
 $75/$0D/          {         JNZ     LOWNIB         nope            }
 $AC/              {         LODSB         Get packed characters    }
 $8A/$E0/          {         MOV     AH,AL                          }
 $D0/$E8/          {         SHR     AL,1  Hi nibble to Low nibble  }
 $D0/$E8/          {         SHR     AL,1                           }
 $D0/$E8/          {         SHR     AL,1                           }
 $D0/$E8/          {         SHR     AL,1                           }
 $EB/$04/          {         JMP     OUTSTR Go process a byte        }
 $8A/$C4/          {LOWNIB:  MOV     AL,AH Do the low nibble        }
 $24/$0F/          {         AND     AL,0FH                         }
 $A8/$0F/          {OUTSTR:  TEST    AL,0FH         Is this a zero  }
 $75/$04/          {         JNZ     OUTDIGIT       Nope            }
 $09/$DB/          {         OR      BX,BX Have we leading nonzeroes}
 $74/$04/          {         JZ      NXTNIB         nope            }
 $43/              {OUTDIGIT:INC     BX    keep track of length     }
 $0C/$30/          {         OR      AL,'0'Make it printable        }
 $AA/              {         STOSB                  save it         }
 $E2/$DB/          {NXTNIB:  LOOP    UNPK           Do it again     }
 $01/$D3/          {         ADD     BX,DX Get length: is there any?}
 $75/$04/          {         JNZ     SAVLEN         Yep             }
 $43/              {         INC     BX             Set length      }
 $B0/$30/          {         MOV     AL,'0'         Make it zero    }
 $AA/              {         STOSB                  save it         }
 $8D/$BE/strg/     {SAVLEN:  LEA     DI,strg[bp]    Point to string }
 $36/$88/$1D/      {         MOV     SS:[DI],BL     Save length     }
 $1F);             {         POP     DS                             }

 ltoa:=strg;       { We can't reference ltoa in inline(), so we do this.}

 end;

procedure atol(strg: longstr; var val:long; var rc: integer);
begin;
inline(

{ This function mimics the Turbo val() procedure: strg is a one to   }
{ 11 character string with an optional leading sign (atol accepts a  }
{ leading '+' or '-' sign, val() only accepts a leading '-' sign).   }
{ val is the long to receive the value.  rc is 0 if the string is    }
{ a null or contains a valid numeric.  Else, rc is the point at which}
{ a nonnumeric was found, or the digit that caused val to overflow.  }
{ like Turbo val() trailing or leading spaces are not allowed.       }
{ atol accepts longs in the rangs +2,147,483,647 to -2,147,483,647.  }
{ -2,147,483,648 generates an error. val() returns an error for      }
{ -32,768.                                                  }

 $33/$C0           {XOR     AX,AX      ;Clear accum}
/$33/$D2           {XOR     DX,DX      ; ...and ext}
/$32/$ED           {XOR     CH,CH      ; and hi cnt}
/$33/$F6           {XOR     SI,SI      ; set rc if no chars}
/$8A/$8E/>strg     {MOV     CL,[strg+BP]; get length}
/$E3/$6D           {JCXZ    EXIT       ; return if no length}
/$8D/$BE/>strg     {LEA     DI,[strg+bp]; point to string}
/$47               {INC     DI         ; point to first char}
/$BE/$FF/$FF       {MOV     SI,-1      ; Flag negative}
/$36/$80/$3D/$2D   {CMP     BYTE PTR SS:[DI],'-'; Minus sign?}
/$74/$3F           {JE      NXTCHR     ; Make negative}
/$BE/$01/$00       {MOV     SI,1       ; Assume positive}
/$36/$80/$3D/$2B   {CMP     BYTE PTR SS:[DI],'+'; Plus sign?}
/$74/$36           {JE      NXTCHR     ; go look at next char}
                   {CHKCHR:}
/$36/$80/$3D/$30   {CMP     BYTE PTR SS:[DI],'0'; Numeric?}
/$7C/$38           {JL      ENDSTR     ; Nope}
/$36/$80/$3D/$39   {CMP     BYTE PTR SS:[DI],'9';            }
/$7F/$32           {JG      ENDSTR     ; Nope                }
/$BB/$0A/$00       {MOV     BX,000A    ; Base value          }
/$50               {PUSH    AX         ; Save low order      }
/$8B/$C2           {MOV     AX,DX      ; Get high order      }
/$F7/$E3           {MUL     BX         ; Shift it            }
/$70/$28           {JO      ENDSTR     ; Too big: error.     }
/$78/$26           {JS      ENDSTR                           }
/$8B/$D0           {MOV     DX,AX      ; Temp Store Hi order }
/$58               {POP     AX         ; Restore low order   }
/$52               {PUSH    DX         ; Save Hi order       }
/$F7/$E3           {MUL     BX         ; Shift low order     }
/$5B               {POP     BX         ; Get low order       }
/$03/$D3           {ADD     DX,BX      ; Add it              }
/$78/$1B           {JS      ENDSTR     ; Too big, exit.      }
/$72/$19           {JC      ENDSTR                           }
/$36/$8A/$1D       {MOV     BL,BYTE PTR SS:[DI] ; Get the digit}
/$32/$FF           {XOR     BH,BH      ; clear for add       }
/$80/$EB/$30       {SUB     BL,'0'     ; Make binary         }
/$03/$C3           {ADD     AX,BX      ; Add this digit      }
/$83/$D2/$00       {ADC     DX,0       ; Whole long          }
/$78/$0A           {JS      ENDSTR     ; Too big, exit.      }
/$72/$08           {JC      ENDSTR                           }
                   {NXTCHR:                                  }
/$47               {INC     DI; point to next char           }
/$E2/$C7           {LOOP    CHKCHR     ; again               }
/$33/$DB           {XOR     BX,BX      ; No error            }
/$EB/$09/$90       {JMP     RETURN                           }
                   {ENDSTR:                                  }
/$8D/$9E/>strg     {LEA     BX,[strg+bp]; Get addr of string }
/$2B/$FB           {SUB     DI,BX      ; Get offset to bad char}
/$8B/$DF           {MOV     BX,DI      ; Set return code     }
                   {RETURN:                                  }
/$0B/$F6           {OR      SI,SI      ; Need to adjust sign?}
/$79/$0A           {JNS     RETURN1    ; nope                }
/$F7/$D0           {NOT     AX                               }
/$F7/$D2           {NOT     DX                               }
/$83/$C0/$01       {ADD     AX,1                             }
/$83/$D2/$00       {ADC     DX,0       ; Whole long          }
                   {RETURN1:                                 }
/$8B/$F3           {MOV     SI,BX      ; Set RC              }
                   {EXIT:}
/$C4/$BE/>rc       {LES     DI,DWORD PTR [BP+rc]}
/$26/$89/$35       {MOV     WORD PTR ES:[DI],SI ; Set RC}
/$C4/$BE/>val      {LES     DI,DWORD PTR [BP+val]}
/$26/$89/$05       {MOV     WORD PTR ES:[DI],AX ; Low word}
/$47               {INC     DI}
/$47               {INC     DI}
/$26/$89/$15);     {MOV     WORD PTR ES:[DI],DX ; High Word}
end;

var num1 : long;
    count1 : integer;
    longone  : long;
    printnum : string[11];

begin
 longone.loword:=$fffe;
 longone.hiword:=$7ffe;
 num1.loword:=$1;
 num1.hiword:=$0;
 printnum:=ltoa(longone);
 writeln(printnum);
 for count1:=1 to 10 do
  begin
   addl(longone,longone,num1);
   printnum:=ltoa(longone);
   writeln(printnum);
  end;
end.



Fri, 13 May 2005 18:04:36 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. About Unsigned Long Integer Numbers

2. How Do I Generate a Random Long Integer

3. integer->hex again (long)

4. Urgent: Need ASCII digits to UNSIGNED Long integer conversion

5. unsigned long integer

6. very long integers

7. very long integers

8. tsdemo17.zip Assorted graphics demonstrations of functions etc

9. sorry, wrong demonstration (stringalignment)

10. storing a list of integers in one integer.

11. Early Paradox and SQL: Like works on integer field?!?! Possibe with current version.

12. Turbo PAscal earlier than 7.0 on P II machine

 

 
Powered by phpBB® Forum Software