home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPTOOL3.ZIP / LONG.INC < prev    next >
Encoding:
Text File  |  1987-03-28  |  18.7 KB  |  476 lines
  1.  
  2. const long_tag: string[90]
  3.    = #0'@(#)CURRENT_FILE LAST_UPDATE Long integer math library 1.0'#0;
  4. #log Long integer math library 1.0
  5.  
  6. (*
  7.  * long.inc - Long integer arithmatic package:
  8.  *
  9.  *  This set of subroutines allow you to compute with integers in the
  10.  *  range of +2,147,483,647 to -2,147,483,648.
  11.  *
  12.  *  Long integers are stored as four bytes (or two words) and are defined by
  13.  *  the 'long' type.
  14.  *
  15.  *  Long integers can be initialized either from a string with optionally
  16.  *  a sign and one to ten digits via the routine 'atol'.  The string must be
  17.  *  of type 'longstr'.
  18.  *
  19.  *  The routine 'itol' allows you to initialize a long from an integer.
  20.  *
  21.  *  Some DOS functions return long integers.
  22.  *
  23.  *  Long integers are converted to strings for display via the 'ltoa' routine.
  24.  *  It returns a string with the type of 'longstr'.
  25.  *
  26.  *)
  27.  
  28.  
  29. type
  30.    long =    record
  31.          loword:   integer;
  32.          hiword:   integer;
  33.    end;
  34.  
  35.    longstr = string [11];
  36.  
  37.  
  38.  
  39. procedure itol (n1:       integer;
  40.                 var n2:   long);
  41.                            { Convert signed to integer n1 to signed long
  42.                              n2 }
  43.  
  44. begin
  45.    n2.loword := n1;
  46.  
  47.    if n1 >= 0 then
  48.       n2.hiword := 0
  49.    else
  50.       n2.hiword :=- 1;
  51. end;
  52.  
  53. procedure addl (var sum:  long;
  54.                 n1,
  55.                 n2:       long);
  56.                            { Add long n1 to n2 producing sum: may be treated 
  57.                              as signed or unsigned }
  58.  
  59. begin
  60.    inline($8B / $86 / n1 /    { MOV AX,n1[bp] }
  61.     $03 / $86 / n2 /          { ADD AX,n2[bp] }
  62.     $C4 / $BE / sum /         { LES DI,sum[BP] }
  63.     $26 / $89 / $05 /         { MOV ES:[DI],AX }
  64.     $BF / $02 / $00 /         { MOV DI,2 }
  65.     $8B / $83 / n1 /          { MOV AX,n1[di+bp] }
  66.     $13 / $83 / n2 /          { ADC AX,n2[di+bp] }
  67.     $C4 / $BE / sum /         { LES DI,sum[BP] }
  68.     $26 / $89 / $45 / $02);   { MOV ES:[DI]+2,AX }
  69.  
  70. end;
  71.  
  72. procedure subl (var diff: long;
  73.                 n1,
  74.                 n2:       long);
  75.                            { subtract long n2 from n1 producing diff: 
  76.                              may be treated as signed or unsigned }
  77.  
  78. begin
  79.    inline($8B / $86 / n1 /    { MOV AX,n1[bp] }
  80.     $2B / $86 / n2 /          { SUB AX,n2[bp] }
  81.     $C4 / $BE / diff /        { LES DI,diff[BP] }
  82.     $26 / $89 / $05 /         { MOV ES:[DI],AX }
  83.     $BF / $02 / $00 /         { MOV DI,2 }
  84.     $8B / $83 / n1 /          { MOV AX,n1[di+bp] }
  85.     $1B / $83 / n2 /          { SBB AX,n2[di+bp] }
  86.     $C4 / $BE / diff /        { LES DI,diff[BP] }
  87.     $26 / $89 / $45 / $02);   { MOV ES:[DI]+2,AX }
  88.    
  89. end;
  90.  
  91. function cmpl (n1:       long;
  92.                op:       longstr;
  93.                n2:       long): boolean;
  94.                            { compares long n1 with n2 returning boolean: 
  95.                              may be treated as signed or unsigned. op 
  96.                              is a string like '>', '<', '=>', '=<', '>=', 
  97.                              '<=', or '='. '<>' is NOT supported: use 
  98.                              NOT(cmpl(n1,'=',n2)) instead. }
  99.  
  100. var
  101.    bool:     boolean;
  102.    
  103. begin
  104.    inline($8B / $86 / n1 /    { MOV AX,n1[bp] }
  105.     $2B / $86 / n2 /          { SUB AX,n2[bp] low order word difference}
  106.     $BF / $02 / $00 /         { MOV DI,2 point to high order words}
  107.     $8B / $9B / n1 /          { MOV BX,n1[di+bp] }
  108.     $1B / $9B / n2 /          { SBB BX,n2[di+bp] high order word difference}
  109.     $30 / $ED /               { XOR CH,CH }
  110.     $8A / $8E / op /          { MOV CL,op[bp] get the string length}
  111.     $8D / $B6 / op /          { LEA SI,op[bp] }
  112.     $46 /                     { INC SI point to the first operator}
  113.     $C6 / $86 / bool / $00 /  { MOV bool[bp],false assume false}
  114.     $E3 / $36 /               { jcxz exit no opeators: false}
  115.  
  116.    { tstops: }
  117.     $36 / $80 / $3C / $3D /   { cmp byte ptr ss:[si],'='}
  118.     $75 / $0A /               { jne opt1 not an equal sign}
  119.     $09 / $DB /               { or bx,bx }
  120.     $75 / $22 /               { jnz nxtop not zero: can't be true}
  121.     $09 / $C0 /               { or ax,ax }
  122.     $75 / $1E /               { jnz nxtop not zero: can't be true}
  123.     $EB / $21 /               { jmp true hi & lo zero: true }
  124.    
  125.    { opt1: }
  126.     $36 / $80 / $3C / $3E /   { cmp byte ptr ss:[si],'>'}
  127.     $75 / $0C /               { jne opt2 not a greater than sign}
  128.     $09 / $DB /               { or bx,bx }
  129.     $78 / $12 /               { js nxtop neg. difference means less than}
  130.     $75 / $15 /               { jnz true pos. difference means greater 
  131.                                 than}
  132.     $09 / $C0 /               { or ax,ax }
  133.     $75 / $11 /               { jnz true pos. difference means greater 
  134.                                 than}
  135.     $EB / $0A /               { jmp nxtop no difference means equal}
  136.    
  137.    { opt2: }
  138.     $36 / $80 / $3C / $3C /   { cmp byte ptr ss:[si],'<'}
  139.     $75 / $0E /               { jne exit invalid operator is false}
  140.     $09 / $DB /               { or Bx,Bx }
  141.     $78 / $05 /               { js true neg. difference means less than}
  142.    
  143.    { nxtop: }
  144.     $46 /                     { INC SI point to next operator}
  145.     $E2 / $D1 /               { LOOP tstops test until true or no more 
  146.                                 operators}
  147.     $EB / $05 /               { JMP EXIT true not found: exit false}
  148.    
  149.    { true: }
  150.     $C6 / $86 / bool / $01);  { MOV bool[bp],true set true}
  151.    
  152.    { exit: }
  153.    
  154.    cmpl := bool;
  155. end;
  156.  
  157. procedure divl (var quo,
  158.                 rem:      integer;
  159.                 n1:       long;
  160.                 n2:       integer);
  161.                            { Divides signed integer n2 into signed long
  162.                              n2, yielding signed integer quotient quo 
  163.                              and signed integer remainder rem }
  164.  
  165. begin
  166.    inline($8B / $86 / n1 /    { MOV AX,n1[bp] }
  167.     $BF / $02 / $00 /         { MOV DI,2 }
  168.     $8B / $93 / n1 /          { MOV DX,n1[bp+di] }
  169.     $8B / $8E / n2 /          { MOV CX,n2[bp] }
  170.     $F7 / $F9 /               { IDIV CX }
  171.     $C4 / $BE / quo /         { LES DI,quo[bp] }
  172.     $26 / $89 / $05 /         { MOV ES:[DI],AX }
  173.     $C4 / $BE / rem /         { LES DI,rem[bp] }
  174.     $26 / $89 / $15);         { MOV ES:[DI],DX }
  175.    
  176. end;
  177.  
  178. procedure multl (var prod: long;
  179.                  n1,
  180.                  n2:       integer);
  181.                            { Multiplies signed integer n2 by signed integer 
  182.                              n2, producing signed long prod. }
  183.  
  184. begin
  185.    inline($8B / $86 / n1 /    { MOV AX,n1[bp] }
  186.     $8B / $8E / n2 /          { MOV CX,n2[bp] }
  187.     $F7 / $E9 /               { IMUL CX }
  188.     $C4 / $BE / prod /        { LES DI,prod[bp] }
  189.     $26 / $89 / $05 /         { MOV ES:[DI],AX }
  190.     $26 / $89 / $55 / $02);   { MOV ES:[DI+2],DX }
  191.    
  192. end;
  193.  
  194. procedure slrl (var quo:  long;
  195.                 shift:    integer);
  196.                            { Shifts quo by number of bits in 'shift' right,
  197.                              filling vacated bits left with zeros. }
  198.  
  199. begin
  200.    inline($cd / $02 / $8B / $8E / shift /
  201.                               { MOV CX,shift[bp] }
  202.     $09 / $C9 /               { OR CX,CX }
  203.     $74 / $18 /               { JZ END }
  204.     $C4 / $BE / quo /         { LES DI,quo[bp] }
  205.     $26 / $8B / $05 /         { MOV AX,ES:[DI] }
  206.     $26 / $8B / $55 / $02 /   { MOV DX,ES:[DI+2] }
  207.  
  208.    {SHIFT:}
  209.     $D1 / $EA /               { SHR DX }
  210.     $D1 / $D8 /               { RCR AX }
  211.     $E2 / $FA /               { LOOP SHIFT }
  212.     $26 / $89 / $05 /         { MOV ES:[DI],AX }
  213.     $26 / $89 / $55 / $02);   { MOV ES:[DI+2],DX }
  214.    
  215.    { END: }
  216.    
  217. end;
  218.  
  219. procedure sarl (var quo:  long;
  220.                 shift:    integer);
  221.                            { Shifts long by number fo bits in 'shift' 
  222.                              right, propagating the sign bit.}
  223.  
  224. begin
  225.    inline($cd / $02 / $8B / $8E / shift /
  226.                               { MOV CX,shift[bp] }
  227.     $09 / $C9 /               { OR CX,CX }
  228.     $74 / $18 /               { JZ END }
  229.     $C4 / $BE / quo /         { LES DI,quo[bp] }
  230.     $26 / $8B / $05 /         { MOV AX,ES:[DI] }
  231.     $26 / $8B / $55 / $02 /   { MOV DX,ES:[DI+2] }
  232.    
  233.    {SHIFT:}
  234.     $D1 / $FA /               { SAR DX }
  235.     $D1 / $D8 /               { RCR AX }
  236.     $E2 / $FA /               { LOOP SHIFT }
  237.     $26 / $89 / $05 /         { MOV ES:[DI],AX }
  238.     $26 / $89 / $55 / $02);   { MOV ES:[DI+2],DX }
  239.    
  240.    { END: }
  241.    
  242. end;
  243.  
  244. procedure slll (var quo:  long;
  245.                 shift:    integer);
  246.                            { Shifts long by number fo bits in 'shift' 
  247.                              left, filling vacated bits on right with 
  248.                              zeros. }
  249.  
  250. begin
  251.    inline($cd / $02 / $8B / $8E / shift /
  252.                               { MOV CX,shift[bp] }
  253.     $09 / $C9 /               { OR CX,CX }
  254.     $74 / $18 /               { JZ END }
  255.     $C4 / $BE / quo /         { LES DI,quo[bp] }
  256.     $26 / $8B / $05 /         { MOV AX,ES:[DI] }
  257.     $26 / $8B / $55 / $02 /   { MOV DX,ES:[DI+2] }
  258.    
  259.    {SHIFT:}
  260.     $D1 / $E0 /               { SHL AX }
  261.     $D1 / $D2 /               { RCL DX }
  262.     $E2 / $FA /               { LOOP SHIFT }
  263.     $26 / $89 / $05 /         { MOV ES:[DI],AX }
  264.     $26 / $89 / $55 / $02);   { MOV ES:[DI+2],DX }
  265.  
  266.    { END: }
  267.    
  268. end;
  269.  
  270. function ltoa (long:     long): longstr;
  271.                            { Converts a long to signed printable ASCII 
  272.                              string }
  273.  
  274. var
  275.    temps:    array [1..5] of char;
  276.    strg:     longstr;
  277.    
  278. begin
  279.    inline($1E /               { PUSH DS }
  280.     $FC /                     { CLD Set direction Forward }
  281.     $8C / $D0 /               { MOV AX,SS }
  282.     $8E / $C0 /               { MOV ES,AX }
  283.     $8E / $D8 /               { MOV DS,AX }
  284.     $32 / $C0 /               { XOR AL,AL Clear AX }
  285.     $8D / $BE / temps /       { LEA DI,TEMPS[BP] Point to working storage }
  286.     $B9 / $05 / $00 /         { MOV CX,5 Five bytes }
  287.    
  288.    {CLEAR:}
  289.     $AA /                     { STOS BYTE PTR [DI] Clear temp variables }
  290.     $E2 / $FD /               { LOOP CLEAR -all of them }
  291.     $B9 / $20 / $00 /         { MOV CX,32 32 bits to convert }
  292.     $8B / $9E / long /        { MOV BX,LONG[BP] Load low order word }
  293.     $BF / $02 / $00 /         { MOV DI,2 ... and ... }
  294.     $8B / $93 / long /        { MOV DX,LONG[BP+DI] hi order word }
  295.     $F7 / $C2 / $00 / $80 /   { TEST DX,$8000 Negative? }
  296.     $74 / $0A /               { JZ NOCOMP Nope }
  297.     $F7 / $D2 /               { NOT DX 1's Complement }
  298.     $F7 / $D3 /               { NOT BX Both }
  299.     $83 / $C3 / $01 /         { ADD BX,1 Add 1 }
  300.     $83 / $D2 / $00 /         { ADC DX,0 Carry over }
  301.    
  302.    {NOCOMP: }
  303.     $FD /                     { STD Set direction backward }
  304.    
  305.    {BITLOOP:}
  306.     $51 /                     { PUSH CX Save bit counter }
  307.     $B9 / $05 / $00 /         { MOV CX,5 Five bytes = ten digits }
  308.     $8D / $B6 / temps /       { LEA SI,TEMPS[BP] Set Indices }
  309.     $83 / $C6 / $04 /         { ADD SI,4 -end of ws }
  310.     $8B / $FE /               { MOV DI,SI }
  311.     $D1 / $E3 /               { SHL BX,1 Get a Bit }
  312.     $D1 / $D2 /               { RCL DX,1 Rotate through all bits }
  313.    
  314.    {BITADD:}
  315.     $AC /                     { LODSB Get a byte }
  316.     $12 / $C0 /               { ADC AL,AL Double adding in carry }
  317.     $27 /                     { DAA Packed adjust }
  318.     $AA /                     { STOSB Save it }
  319.     $E2 / $F9 /               { LOOP BITADD for another two digits }
  320.     $59 /                     { POP CX get bit counter }
  321.     $E2 / $E5 /               { LOOP BITLOOP another bit }
  322.     $FC /                     { CLD Go forward }
  323.     $8D / $BE / strg /        { LEA DI,strg[bp] Point to string }
  324.     $47 /                     { INC DI Point to character }
  325.     $33 / $D2 /               { XOR DX,DX Clear DX - length counter}
  326.     $BE / $02 / $00 /         { MOV SI,2 Offset to hi order }
  327.     $F7 / $82 / long /        { TEST LONG[BP+SI],8000 Negative? }
  328.     $00 / $80 / $74 / $04 /   { JZ NOSIGNED Nope }
  329.     $42 /                     { INC DX Set length }
  330.     $B0 / $2D /               { MOV AL,'-' Make it minus }
  331.     $AA /                     { STOSB save it }
  332.    
  333.    {UNSIGNED:}
  334.     $8D / $B6 / temps /       { LEA SI,TEMPS[BP] Point to working storage }
  335.     $B9 / $0A / $00 /         { MOV CX,10 Ten bytes }
  336.     $33 / $DB /               { XOR BX,BX Clear BX - length counter}
  337.    
  338.    {UNPK:}
  339.     $F7 / $C1 / $01 / $00 /   { TEST CX,1 High order? }
  340.     $75 / $0D /               { JNZ LOWNIB nope }
  341.     $AC /                     { LODSB Get packed characters }
  342.     $8A / $E0 /               { MOV AH,AL }
  343.     $D0 / $E8 /               { SHR AL,1 Hi nibble to Low nibble }
  344.     $D0 / $E8 /               { SHR AL,1 }
  345.     $D0 / $E8 /               { SHR AL,1 }
  346.     $D0 / $E8 /               { SHR AL,1 }
  347.     $EB / $04 /               { JMP OUTSTR Go process a byte }
  348.    
  349.    {LOWNIB:}
  350.     $8A / $C4 /               { MOV AL,AH Do the low nibble }
  351.     $24 / $0F /               { AND AL,0FH }
  352.    
  353.    {OUTSTR:}
  354.     $A8 / $0F /               { TEST AL,0FH Is this a zero }
  355.     $75 / $04 /               { JNZ OUTDIGIT Nope }
  356.     $09 / $DB /               { OR BX,BX Have we leading nonzeroes}
  357.     $74 / $04 /               { JZ NXTNIB nope }
  358.    
  359.    {OUTDIGIT:}
  360.     $43 /                     { INC BX keep track of length }
  361.     $0C / $30 /               { OR AL,'0' Make it printable }
  362.     $AA /                     { STOSB save it }
  363.    
  364.    {NXTNIB:}
  365.     $E2 / $DB /               { LOOP UNPK Do it again }
  366.     $01 / $D3 /               { ADD BX,DX Get length: is there any?}
  367.     $75 / $04 /               { JNZ SAVLEN Yep }
  368.     $43 /                     { INC BX Set length }
  369.     $B0 / $30 /               { MOV AL,'0' Make it zero }
  370.     $AA /                     { STOSB save it }
  371.    
  372.    {SAVLEN:}
  373.     $8D / $BE / strg /        { LEA DI,strg[bp] Point to string }
  374.     $36 / $88 / $1D /         { MOV SS:[DI],BL Save length }
  375.     $1F);                     { POP DS }
  376.    
  377.    ltoa := strg;              { We can't reference ltoa in inline(), so 
  378.                                 we do this. }
  379.    
  380. end;
  381.  
  382. procedure atol (strg:     longstr;
  383.                 var val:  long;
  384.                 var rc:   integer);
  385.                            { This function mimics the Turbo val() procedure: 
  386.                              strg is a one to 11 character string with 
  387.                              an optional leading sign (atol accepts a 
  388.                              leading '+' or '-' sign, val() only accepts 
  389.                              a leading '-' sign). val is the long to 
  390.                              receive the value. rc is 0 if the string 
  391.                              is a null or contains a valid numeric. Else,
  392.                              rc is the point at which a nonnumeric was 
  393.                              found, or the digit that caused val to overflow. 
  394.                              like Turbo val() trailing or leading spaces 
  395.                              are not allowed. atol accepts longs in the 
  396.                              rangs +2,147,483,647 to -2,147,483,647. 
  397.                              -2,147,483,648 generates an error. val() 
  398.                              returns an error for -32,768. }
  399.  
  400. begin
  401.    inline($33 / $C0           { XOR AX,AX ;Clear accum }
  402.     / $33 / $D2               { XOR DX,DX ; ...and ext }
  403.     / $32 / $ED               { XOR CH,CH ; and hi cnt }
  404.     / $33 / $F6               { XOR SI,SI ; set rc if no chars }
  405.     / $8A / $8E / strg        { MOV CL,[strg+BP]; get length }
  406.     / $E3 / $6D               { JCXZ EXIT ; return if no length }
  407.     / $8D / $BE / strg        { LEA DI,[strg+bp]; point to string }
  408.     / $47                     { INC DI ; point to first char }
  409.     / $BE / $FF / $FF         { MOV SI,-1 ; Flag negative }
  410.     / $36 / $80 / $3D / $2D   { CMP BYTE PTR SS:[DI],'-'; Minus sign? }
  411.     / $74 / $3F               { JE NXTCHR ; Make negative }
  412.     / $BE / $01 / $00         { MOV SI,1 ; Assume positive }
  413.     / $36 / $80 / $3D / $2B   { CMP BYTE PTR SS:[DI],'+'; Plus sign? }
  414.     / $74 / $36               { JE NXTCHR ; go look at next char }
  415.  
  416.    {CHKCHR: }
  417.     / $36 / $80 / $3D / $30   { CMP BYTE PTR SS:[DI],'0'; Numeric? }
  418.     / $7C / $38               { JL ENDSTR ; Nope }
  419.     / $36 / $80 / $3D / $39   { CMP BYTE PTR SS:[DI],'9'; }
  420.     / $7F / $32               { JG ENDSTR ; Nope }
  421.     / $BB / $0A / $00         { MOV BX,000A ; Base value }
  422.     / $50                     { PUSH AX ; Save low order }
  423.     / $8B / $C2               { MOV AX,DX ; Get high order }
  424.     / $F7 / $E3               { MUL BX ; Shift it }
  425.     / $70 / $28               { JO ENDSTR ; Too big: error. }
  426.     / $78 / $26               { JS ENDSTR }
  427.     / $8B / $D0               { MOV DX,AX ; Temp Store Hi order }
  428.     / $58                     { POP AX ; Restore low order }
  429.     / $52                     { PUSH DX ; Save Hi order }
  430.     / $F7 / $E3               { MUL BX ; Shift low order }
  431.     / $5B                     { POP BX ; Get low order }
  432.     / $03 / $D3               { ADD DX,BX ; Add it }
  433.     / $78 / $1B               { JS ENDSTR ; Too big, exit. }
  434.     / $72 / $19               { JC ENDSTR }
  435.     / $36 / $8A / $1D         { MOV BL,BYTE PTR SS:[DI] ; Get the digit }
  436.     / $32 / $FF               { XOR BH,BH ; clear for add }
  437.     / $80 / $EB / $30         { SUB BL,'0' ; Make binary }
  438.     / $03 / $C3               { ADD AX,BX ; Add this digit }
  439.     / $83 / $D2 / $00         { ADC DX,0 ; Whole long }
  440.     / $78 / $0A               { JS ENDSTR ; Too big, exit. }
  441.     / $72 / $08               { JC ENDSTR }
  442.  
  443.    {NXTCHR: }
  444.     / $47                     { INC DI; point to next char }
  445.     / $E2 / $C7               { LOOP CHKCHR ; again }
  446.     / $33 / $DB               { XOR BX,BX ; No error }
  447.     / $EB / $09 / $90         { JMP RETURN }
  448.  
  449.    {ENDSTR: }
  450.     / $8D / $9E / strg        { LEA BX,[strg+bp]; Get addr of string }
  451.     / $2B / $FB               { SUB DI,BX ; Get offset to bad char }
  452.     / $8B / $DF               { MOV BX,DI ; Set return code }
  453.  
  454.    {RETURN: }
  455.     / $0B / $F6               { OR SI,SI ; Need to adjust sign? }
  456.     / $79 / $0A               { JNS RETURN1 ; nope }
  457.     / $F7 / $D0               { NOT AX }
  458.     / $F7 / $D2               { NOT DX }
  459.     / $83 / $C0 / $01         { ADD AX,1 }
  460.     / $83 / $D2 / $00         { ADC DX,0 ; Whole long }
  461.    
  462.    {RETURN1: }
  463.     / $8B / $F3               { MOV SI,BX ; Set RC }
  464.    
  465.    {EXIT: }
  466.     / $C4 / $BE / rc          { LES DI,DWORD PTR [BP+rc] }
  467.     / $26 / $89 / $35         { MOV WORD PTR ES:[DI],SI ; Set RC }
  468.     / $C4 / $BE / val         { LES DI,DWORD PTR [BP+val] }
  469.     / $26 / $89 / $05         { MOV WORD PTR ES:[DI],AX ; Low word }
  470.     / $47                     { INC DI }
  471.     / $47                     { INC DI }
  472.     / $26 / $89 / $15);       { MOV WORD PTR ES:[DI],DX ; High Word }
  473.    
  474. end;
  475.  
  476.