;================================================================ ; These routines allow arbitrary precision integer arithmetic ; in TURBO Pascal ;================================================================ len equ 0 ; offset of length byte for long int valid equ 1 ; offset of validity byte data equ 2 ; offset of long integer data cseg org 0 ; only code segment significant mov bx,sp ; function code on stack mov bx,ss: word ptr 2 [ bx ] ; fetch function code add bx,bx ; index to two-byte table call disp ; dispatch proper routine tab dw offset iadd - offset tab ; function 0 -- add dw offset isub - offset tab ; function 1 -- subtract dw offset iinc - offset tab ; function 2 -- increment dw offset ineg - offset tab ; function 3 -- negate dw offset isgn - offset tab ; function 4 -- return sign dw offset icnv - offset tab ; function 5 -- convert short integer dw offset icmp - offset tab ; function 6 -- compare dw offset iodd - offset tab ; function 7 -- return odd/even dw offset ihlv - offset tab ; function 8 -- halve dw offset idbl - offset tab ; function 9 -- double disp: pop ax ; offset of beginning of table add bx,ax ; address of routine offset mov bx,cs: word ptr 0 [bx] ; load routine offset add bx,ax ; calculate routine address jmp bx ; call the routine ; add two long integers iadd: push ds ; save Pascal data segment les si,dword ptr 4 [ bp ] ; second argument lds di,dword ptr 8 [ bp ] ; first argument xor cx,cx ; clear ch and carry mov cl, es: byte ptr len [ si ] ; length of long integers mov bx,data ; offset of data area iadd1: mov ax,es: word ptr 0 [ bx + si ] adc word ptr 0 [ bx + di ], ax jo iaddv ; jump if overflow inc bx inc bx loop iadd1 ; back for next word mov al,es: byte ptr valid [ si ] and byte ptr valid [ di ], al ; result valid flag is logical iadd2: pop ds ; AND of operand valid flags ret 2 ; discard argument word iaddv: inc bx ; on to next word inc bx loop iadd1 mov byte ptr valid [ di ], 0 ; set 'invalid' flag on result jmps iadd2 ; subtract two long integers isub: push ds ; save Pascal data segment les si,dword ptr 4 [ bp ] ; second argument lds di,dword ptr 8 [ bp ] ; first argument xor cx,cx ; clear ch and carry mov cl, es: byte ptr len [ si ] ; length of long integers mov bx,data ; offset of data area isub1: mov ax,es: word ptr 0 [ bx + si ] sbb word ptr 0 [ bx + di ], ax jo isubv ; jump if overflow inc bx inc bx loop isub1 ; back for next word mov al,es: byte ptr valid [ si ] and byte ptr valid [ di ], al ; result valid flag is logical isub2: pop ds ; AND of operand valid flags ret 2 ; discard argument word isubv: inc bx inc bx loop isub1 ; back for next word mov byte ptr valid [ di ], 0 ; set 'invalid' flag on result jmps isub2 ; increment a long integer iinc: push ds lds di,dword ptr 4 [ bp ] ; get argument xor cx,cx mov dx,cx ; save zero mov cl,byte ptr len [ di ] ; get length ( in words ) mov bx,data ; offset of integer data stc iinc1: jnc iinc2 ; if no carry, we're done adc word ptr 0 [ bx + di ], dx jo iincv ; jump if overflow inc bx inc bx loop iinc1 iinc2: pop ds ret 2 iincv: inc bx inc bx loop iinc1 ; on to next word mov byte ptr valid [ di ], 0 ; set 'invalid' flag jmps iinc2 ; negate a long integer ineg: push ds lds di,dword ptr 4 [ bp ] ; get argument xor cx,cx mov dx,cx ; save zero mov cl,byte ptr len [ di ] ; get length ( in words ) mov bx,data ; offset of integer data stc ineg1: mov ax,word ptr 0 [ bx + di ] ; get next piece of integer not ax ; complement adc ax,dx ; add 1 mov word ptr 0 [ bx + di ], ax ; put it back jo inegv ; jump if overflow inc bx inc bx loop ineg1 ineg2: pop ds ret 2 inegv: inc bx inc bx loop ineg1 ; back for next word mov byte ptr valid [ di ], 0 ; set invalid flag jmps ineg2 ; return sign of long integer ( 1, 0, or -1 ) isgn: les di,dword ptr 4 [ bp ] ; get argument xor cx,cx mov cl, es: byte ptr len [ di ]; get length ( in words ) dec cx ; length minus 1 add di,cx add di,cx add di,data ; address last word test es: byte ptr 1 [ di ], 080h jz isgn1 ; jump if >> not << negative mov word ptr 8 [ bp ], -1 ; return minus one jmps isgn3 isgn1: inc cx ; number of data words xor ax,ax ; generate zero std ; backwards scan repe scasw ; while data word is zero cld ; reset direction flag je isgn2 ; jump if completely zero inc ax ; generate a one isgn2: mov word ptr 8 [ bp ], ax ; return 1 or zero isgn3: ret 2 ; convert short integer to long integer icnv: les di,dword ptr 6 [ bp ] ; address first argument xor cx,cx mov cl,es: byte ptr len [ di ] ; get length ( in words ) add di,data ; address data portion mov ax,word ptr 4 [ bp ] ; get second argument stosw ; put it where it belongs dec cx jcxz icnv2 ; jump if longs are one(!) word or ax,ax ; test sign mov ax,0 ; assume positive jns icnv1 ; jump if assumption correct not ax ; number is negative icnv1: rep stosw ; fill out long integer with sign icnv2: ret 2 ; return sign of first operand minus second icmp: push ds lds si,dword ptr 4 [ bp ] ; get second operand les di,dword ptr 8 [ bp ] ; get first operand xor cx,cx mov cl,byte ptr len [ si ] ; get long integer len mov bx,cx dec bx add bx,bx add bx,data ; address high-order word mov ax, word ptr 0 [ bx + si ] ; of second operand xor ax, es: word ptr 0 [ bx + di ] js icmp6 ; jump if signs are different icmp1: mov ax, es: word ptr 0 [ bx + di ] ; parameter 1 cmp ax, word ptr 0 [ bx + si ] ; parameter 2 jnz icmp3 ; jump if inequality detected dec bx dec bx loop icmp1 ; back for next word xor ax,ax ; generate 0 -- params are equal jmps icmp4 ; jump to store result icmp3: mov ax,1 ; assume first operand larger jnc icmp4 ; jump if assumption is correct mov ax,0ffffh ; no! first is smaller icmp4: mov word ptr 12 [ bp ], ax ; save conclusion pop ds ret 2 icmp6: test byte ptr 1 [ bx + si ],080h ; test sign of second operand mov ax,1 ; assume negative -- first larger jnz icmp4 ; jump if assumption correct mov ax,0ffffh ; second positive -- first smaller jmps icmp4 ; test whether long integer is odd iodd: les di,dword ptr 4 [ bp ] ; address argument mov ax,es: word ptr data [ di ] ; get low order word and ax,1 ; extract low bit mov byte ptr 8 [ bp ], al ; store result ret 2 ; halve long integer ( works correctly only if it is positive ) ihlv: les di,dword ptr 4 [ bp ] ; address argument xor cx,cx mov cl,es: byte ptr len [ di ] ; get length ( in words ) dec cx add di,cx add di,cx add di,data ; address last word sar es:word ptr 0 [ di ], 1 ; shift right one bit jcxz ihlv2 ihlv1: dec di ; move on to next word dec di rcr es: word ptr 0 [ di ], 1 ; shift it right loop ihlv1 ihlv2: ret 2 ; double a long integer idbl: les di,dword ptr 4 [ bp ] ; address argument xor cx,cx mov cl,es: byte ptr len [ di ] ; get length ( in words ) clc mov bx,data idbl1: mov ax,es: word ptr 0 [ bx + di ] adc es: word ptr 0 [ bx + di ], ax jo idblv ; jump if overflow inc bx inc bx loop idbl1 idbl2: ret 2 idblv: inc bx inc bx loop idbl1 ; back for next word mov es: byte ptr valid [ di ], 0 jmps idbl2 end