(defvar BN←DIGIT←SIZE 16)
(defvar #:system:NO←BYTE←IN←DIGIT (div BN←DIGIT←SIZE 8))
(defmacro defC (name ltype type)
(let ( (Cname (concat "←" name)) (Lname (implode (explode name))) )
`(progn
(defextern ,Cname
,(nsubst 'string 'N (nsubst 'fix 'I (subst 't 'Ad ltype)))
,(cassq type '((N . string) (I . t) (Ad . t))) )
(synonymq ,Lname ,Cname)
(remfn ',Cname)
',Lname )))
(unless (featurep 'kern)
(cond ((eq 0 (getglobal "←BnAlloc"))
(let ( (l #:system:path) f )
(while (and l (null (probefile
(setq f (catenate (car l) "kern.o")))))
(nextl l))
(ifn l
(error 'kern "Je ne trouve pas kern.o dans le path" ())
(cload f) ))))
(add-feature 'kern) )
'(defC "BnAlloc" (I) N)
'(defC "BnCreate" (Ad I) N)
'(defC "BnFree" (N) Fix)
'(defC "BnGetType" (N) Ad)
'(defC "BnSetType" (N Ad) U)
'(defC "BnGetSize" (N) I)
(defC "BnSetToZero" (N I I) U)
(defC "BnAssign" (N I N I I) U)
(defC "BnSetDigit" (N I Fix) U)
(defC "BnGetDigit" (N I) Fix)
(defC "BnNumDigits" (N I I) I)
(defC "BnNumLeadingZeroBitsInDigit" (N I) Fix)
(defC "BnDoesDigitFitInWord" (N I) Fix)
(defC "BnIsDigitZero" (N I) Fix)
(defC "BnIsDigitNormalized" (N I) Fix)
(defC "BnIsDigitOdd" (N I) Fix)
(defC "BnCompareDigits" (N I N I) Fix)
(defC "BnComplement" (N I I) U)
(defC "BnAndDigits" (N I N I) U)
(defC "BnOrDigits" (N I N I) U)
(defC "BnXorDigits" (N I N I) U)
(defC "BnShiftLeft" (N I I N I Fix) U)
(defC "BnShiftRight" (N I I N I fix) U)
(defC "BnAddCarry" (N I I Fix) Fix)
(defC "BnAdd" (N I I N I I Fix) Fix)
(defC "BnSubtractBorrow" (N I I Fix) Fix)
(defC "BnSubtract" (N I I N I I Fix) Fix)
(defC "BnMultiplyDigit" (N I I N I I N I) Fix)
(defC "BnDivideDigit" (N I N I N I I N I) U)
)
(defun BnAlloc (i)
(makestring (mul #:system:NO←BYTE←IN←DIGIT i) 0))
(defun BnCreate (Ad i)
(let ( (n (makestring (mul #:system:NO←BYTE←IN←DIGIT i) 0)) )
(typestring n Ad)
n ))
(defun BnFree (n))
(defun BnGetType (n)
(typestring n))
(defun BnSetType (n Ad)
(typestring n Ad))
(defun BnGetSize (n)
(div (slen n) #:system:NO←BYTE←IN←DIGIT))
(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) )))))