(defvar BN←DIGIT←SIZE 16)
; Le pre'sent fichier ne marche qu'en 15.2:
(unless (>= (version) 15.2)
(error 'load 'errifc 'kern))
; Arithmetique Machine: fichier kern.ll
(add-feature 'kern)
; Pour se pre'munir contre les fanatiques du CASE de'pendant:
(defvar #:backup:majuscules #:SYSTEM:READ-CASE-FLAG
#:SYSTEM:READ-CASE-FLAG ())
(dmd incr1 (n) `(setq ,n (add1 ,n)))
(dmd decr1 (n) `(setq ,n (sub1 ,n)))
#|
.Chapitre O "Arithme'tique Machine"
.Auteur "F. Morain, B. Serpette, J. Vuillemin, P. Zimmermann"
Pour avoir une arithmetique rapide, les ope'rations qui suivent
doivent etre code'es en langage machine. Ce fichier donne une
spe'cification pre'cise de ces ope'rations.
La Base est laisse'e au choix de l'implanteur. Nous recommendons
Base=2**32, et ce fichier utilise Base=2**16 de LeLisp15.2.
Les algorithmes sont inde'pendants du choix de Base=2**Log2Base,
qui doit e↑tre une puisance de 2, et dont le nombre de bits
est dans la variable Log2Base.
|#
(defvar #:ex:regret 0)
#|
Un bit b, avec -2<b<2, est repre'sente' par un fix LeLisp.
.br
Un chiffre C, avec 0<=C<Base, est repe're' par un nom n de tableau et
un index nd dans ce tableau, soit C=n[nd]=(aref n nd). Son codage interne
peut e↑tre arbitraire.
.br
Un tableau de chiffres N est repe're' par un nom n de tableau, un index
nd>=0 de de'but et une longueur nl>=0 donnant le nombre de chiffres de n
dans la Base. L'entier naturel N=val<n,nd,nl> ainsi repre'sente' vaut
la somme, pour 0<=i<ln, de n[nd+i]*Base**i.
.br
Remarque: un chiffre C est un tableau d'entiers de longueur 1. Un tableau
de longueur 0 vaut 0.
Toutes les ope'rations supposent, sans le tester, que les indices sont bien
dans des tableaux existants. De plus, chaque ope'ration suppose ve'rifie'e
diverses pre'conditions, sur les longueurs respectives des ope'randes
et leurs valeurs arithme'tiques. Aucunne de ces pre-conditions n'est
explicitement teste'e. L'usage de ces routines hors de ces conditions
conduit a` des de'sastres.
Les ope'rations ont un format fixe et ne n'allouent pas de me'moire.
Elles ont en ge'ne'ral un effet de bord sur leur premier argument.
|#
#|
.bp
.Section "Repre'sentation des tableaux de chiffres"
N est represente' par #:N:#[n0 ... nl-1].
Les ni sont des chiffres de la base, poids faibles en n0.
.SSection "Cre'ation des entiers"
(BnCreate typ nl) cre'e un tableau de nl chiffres e'gaux a` 0,
et lui affecte le type typ, soit typ[0,...0]
|#
(de BnCreate (type nl)
(let ((v (makevector nl 0)))
(typevector v type)
v))
(de BnAlloc (nl)
(makevector nl 0))
(de BnFree (n))
#|
Avec un argument, (typeN n) renvoie le type de n.
|#
(de BnGetType (n)
(typevector n))
(de BnSetType (n typ)
(typevector n typ))
; (BnGetSize n) retourne le nombre de chiffres de n:
(de BnGetSize (n) (vlength n))
; (BnNumDigits n nd nl) retourne le nombre de chiffre de n, apre`s
; e'limination des chiffres nuls de tete non significatifs.
; (BnNumDigits [1 2 0 0] 0 2) = 2
; (BnNumDigits [0 0 0 0] 0 4) = 1
(de BnNumDigits (n nd nl)
(if (eq nl 0)
1
(setq nl (add nd nl))
(while (and (gt (decr1 nl) nd) (eq 0 (vref n nl))))
(add1 (sub nl nd))))
; .SSection "modification et copie"
; transfert: m[md]...m[md+nl-1] <- n[nd]...n[nd+nl-1]
(de BnAssign (m md n nd nl)
(bltvector m md n nd nl))
; remise a zero de n[nd]...n[nd+nl-1]:
(de BnSetToZero (n nd nl)
(while (ge (decr1 nl) 0) (vset n nd 0) (incr1 nd)))
; .Section "Coertions entre fix LeLisp et chiffres"
; C[cd] <- fix
(de BnSetDigit (C cd fix)
(vset C cd fix))
; Coertion inverse de C[cd] en fix;
; renvoie nil si C[nd]>=2**15
(de BnDoesDigitFitInWord (C cd)
(if (ge (vref C cd) 0)
1
0))
(de BnGetDigit (c cd)
(vref c cd))
; .Section "Comparaison"
; (BnCompareDigits n nd m md) retourne -1,0,1 suivant le signe de
; N-M = n[nd]-m[md]:
(de BnCompareDigits (n nd m md)
(ex? (vref n nd) (vref m md)))
(de BnIsDigitZero (C cd)
(if (eq 0 (vref c cd))
1
0))
; .Section "Comple'mentation a` la Base"
; Soit N=val<n,nd,nl>
; .br
; (BnComplement n nd nl) remplace N par Base**nl - N - 1:
(de BnComplement (n nd nl)
(while (ge (decr1 nl) 0)
(vset n nd (ex- (vref n nd))) (incr1 nd)))
#|
.Section "Addition"
L'addition N+M+r incr1e'mente en place N de M+r, et retourne une retenue.
.br
On suppose 0<=r<=1 et nl>=ml.
.br
Soient N=val<n,nd,nl> , M=val<m,md,ml>, S=N+M+r=S0+s1*Base**nl
.br
(BnAddCarry n nd nl m md ml r) retourne s1, qui vaut 0 ou 1, et remplace les
nl chiffres de n par ceux de S0.
|#
; On suppose donc 0<=r<=1 et nl>=ml.
(de BnAdd (m md ml n nd nl r)
(setq #:ex:regret r ml (sub ml nl))
(while (ge (decr1 nl) 0)
(vset m md (ex+ (vref m md) (vref n nd))) (incr1 nd) (incr1 md))
(BnAddCarry m md ml #:ex:regret))
; propagation d'une retenue.
; n[nd]...n[nd+nl-1] <- n[nd]...n[nd+nl-1] + r, et on retourne la retenue
; sortante.
(de BnAddCarry (n nd nl r)
(setq #:ex:regret r)
(while (and (neq #:ex:regret 0) (ge (decr1 nl) 0))
(vset n nd (ex+ (vref n nd) 0)) (incr1 nd))
(ex+ 0 0))
; .Section "Soustraction en place"
; Soustraction en place de N moins M, avec nl>=ml
(de BnSubtract (m md ml n nd nl e)
; B-n-1->n
; On bousille provisoirement n
(BnComplement n nd nl)
; m+B-n-1 -> m sur md..md+nl-1
(setq e (BnAdd m md nl n nd nl e))
; on restitue la valeur de n
(BnComplement n nd nl)
; on propage l'emprunt
(BnSubtractBorrow m (add md nl) (sub ml nl) e))
; Contient la constante Base-1
(defvar #:N:C-1
(let ((res (BnCreate 'N 1)))
(BnComplement res 0 1) res))
; Propagation de l'emprunt
(de BnSubtractBorrow (n nd nl e)
(while (and (eqn e 0) (ge (decr nl) 0))
(setq e (BnAdd n nd 1 #:N:C-1 0 1 0))
(incr nd))
e)
#|
.Section "Multiplication par un Chiffre"
L'ope'ration de base est la multiplication de n chiffres par un chiffre,
avec accumulation dans n+1 chiffres, et production d'une retenue 0 ou 1.
Soient N=val<n,nd,nl> , C=m[md], P=val<p,pd,nl+1>
.br
S = P+N*C = S0+s1*Base**nl+1
(BnMultiplyDigit p pd pl n nd nl m md) retourne s1, qui vaut 0 ou 1,
et remplace les nl+1 chiffres de P par ceux de S0.
.br
On suppose pl>nl.
|#
; p[pd]...p[pd+pl] <- p[pd]...p[pd+pl] + C[cd] * n[nd]...n[nd+nl-1].
; On retourne la retenue sortante.
(de BnMultiplyDigit (p pd pl n nd nl C cd)
(cond ((eq (vref C cd) 0) 0) ; Multiplication par 0
((eq (vref C cd) 1) ; La multiplication par 1
(BnAdd p pd pl n nd nl 0)) ; degenere en addition
(T (while (ge (setq nl (sub1 nl)) 0)
(vset p pd
(ex* (vref n nd) (vref C cd) (vref p pd)))
(setq pd (add1 pd))
(setq nd (add1 nd))
(setq pl (sub1 pl)))
(while (ge (setq pl (sub1 pl)) 0)
; lorsque pl > nl+1, il faut propager jusqu'au bout
; sinon le code de N+N*N devient faux !!
(vset p pd (ex+ (vref p pd) 0))
(setq pd (add1 pd)))
(ex+ 0 0))))
#|
.Section "Division de N par C"
n = q * C + r.
n = n[nd]...n[nd+nl-1]
q = q[qd]...q[qd+nl-2]
r = r[rd].
Suppose #:ex:regret = 0 au de'part, n > d, n[nd+nl-1] < C[cd]
|#
(de BnDivideDigit (q qd r rd n nd nl C cd)
(let ((nf nl)
(qf (sub1 (add qd nl)))
(cc (vref C cd))
(tmp (BnCreate 'N nl)))
(BnAssign tmp 0 n nd nl)
(setq #:ex:regret (vref tmp (decr1 nf)))
(while (ge (decr1 nf) 0)
(decr1 qf)
(vset q qf (ex/ (vref tmp nf) cc)))
(vset r rd (ex+ 0 0))))
; .Section "De'calages"
; Cf manuel, section 4.2.3.
; de'cale n de s (< BN←DIGIT←SIZE) bits vers la gauche (multiplication
; par 2**s). Les s bits sortant sont place's dans les poids faibles de C[cd].
; Les s bits laisse's vacant sont remplace's par des ze'ros.
; attention : on multiplie sur nl+1 chiffres.
(de BnShiftLeft (n nd nl C cd s)
(let ((2**s 1) (tmp (BnCreate 'N (add1 nl))) (tmpd 0)
(CC (BnCreate 'N 1)))
; calcul de 2**s
(repeat s (setq 2**s (mul 2**s 2)))
(BnSetDigit CC 0 2**s)
; calcul de (2**s)*n -> tmp
(BnMultiplyDigit tmp 0 (add1 nl) n nd nl CC 0)
; n <- tmp
(BnAssign n nd tmp 0 nl)
; recopie des s bits sortant dans C
(BnAssign C cd tmp nl 1)))
; de'cale n de s (< BN←DIGIT←SIZE) bits vers la droite (division par
; 2**s). Les s bits sortant sont place's dans les poids forts de C[cd].
; Les s bits laisse's vacant sont remplace's par des ze'ros.
(de BnShiftRight (n nd nl C cd s)
(let ((2**s 1) (CC (BnCreate 'N 1)) (tmp (BnCreate 'N (add1 nl))))
(if (eqn s 0)
(vset C cd 0)
; calcul de 2**s
(repeat s (setq 2**s (mul 2**s 2)))
(BnSetDigit CC 0 2**s)
(BnAssign tmp 0 n nd nl)
; division de tmp par 2**s avec quotient dans n
(BnDivideDigit n nd C cd tmp 0 (add1 nl) CC 0)
; C[cd] <- C[cd] * 2↑(BN←DIGIT←SIZE-s)
(setq s (sub BN←DIGIT←SIZE s))
(vset C cd (logshift (vref C cd) s)))))
; .Section "Fonctions boole'ennes"
; and logique entre deux chiffres
(de BnAndDigits (n nd m md)
(vset n nd (logand (vref n nd) (vref m md))))
; or logique entre deux chiffres
(de BnOrDigits (n nd m md)
(vset n nd (logor (vref n nd) (vref m md))))
; xor logique entre deux chiffres
(de BnXorDigits (n nd m md)
(vset n nd (logxor (vref n nd) (vref m md))))
; test de parite' de n[nd]
(de BnIsDigitOdd (n nd)
(if (oddp (vref n nd))
1
0))
; .SSection "Logarithme binaire"
; Soit c[cd]<>0. Renvoie le plus petit m tel que Base/2<=(c[nd]+1)*2**m<Base.
(de BnNumLeadingZeroBitsInDigit (d nd)
(let ((gol2 0) (c (vref d nd)))
(if (eq c 0)
BN←DIGIT←SIZE
(while (ge c 0) (setq c (mul c 2) gol2 (add1 gol2)))
gol2)))
; Retourne 0 si n[nd] > 0
(de BnIsDigitNormalized (n nd)
(if (ge (vref n nd) 0)
0
1))
(defvar #:KerN:tampon (BnCreate 'n 2))
(defun #:N:prin (s)
(let ( cnt )
(with ( (obase 16) )
(for (i (sub1 (BnGetSize s)) -1 0)
(BnAssign #:KerN:tampon 0 s i 1)
(setq cnt 0)
(while (< cnt BN←DIGIT←SIZE)
(BnShiftLeft #:KerN:tampon 0 1 #:KerN:tampon 1 4)
(prin (BnGetDigit #:KerN:tampon 1))
(incr cnt 4) )))))
(setq #:SYSTEM:READ-CASE-FLAG #:backup:majuscules)
; Fin du fichier.