(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) )))))