(loader '((title |askern.lo|)))
(defvar bn←digit←size 32)
(if (eq 0 (getglobal "BnDivideDigit")) (progn (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)))))
(if (not (featurep 'kern)) (progn (add-feature 'kern) (setfn 'bnsettozero 'subr3 (getglobal "BnSetToZero")) (setfn 'bnassign 'nsubr (getglobal "BnAssign")) (setfn 'bnsetdigit 'subr3 (getglobal "BnSetDigit")) (setfn 'bngetdigit 'subr2 (getglobal "BnGetDigit")) (setfn 'bnnumdigits 'subr3 (getglobal "BnNumDigits")) (setfn 'bnnumleadingzerobitsindigit 'subr2 (getglobal "BnNumLeadingZeroBitsInDigit")) (setfn 'bndoesdigitfitinword 'subr2 (getglobal "BnDoesDigitFitInWord")) (setfn 'bnisdigitzero 'subr2 (getglobal "BnIsDigitZero")) (setfn 'bnisdigitnormalized 'subr2 (getglobal "BnIsDigitNormalized")) (setfn 'bnisdigitodd 'subr2 (getglobal "BnIsDigitOdd")) (setfn 'bncomparedigits 'nsubr (getglobal "BnCompareDigits")) (setfn 'bncomplement 'subr3 (getglobal "BnComplement")) (setfn 'bnanddigits 'nsubr (getglobal "BnAndDigits")) (setfn 'bnordigits 'nsubr (getglobal "BnOrDigits")) (setfn 'bnxordigits 'nsubr (getglobal "BnXorDigits")) (setfn 'bnshiftleft 'nsubr (getglobal "BnShiftLeft")) (setfn 'bnshiftright 'nsubr (getglobal "BnShiftRight")) (setfn 'bnaddcarry 'nsubr (getglobal "BnAddCarry")) (setfn 'bnadd 'nsubr (getglobal "BnAdd")) (setfn 'bnsubtractborrow 'nsubr (getglobal "BnSubtractBorrow")) (setfn 'bnsubtract 'nsubr (getglobal "BnSubtract")) (setfn 'bnmultiplydigit 'nsubr (getglobal "BnMultiplyDigit")) (setfn 'bndividedigit 'nsubr (getglobal "BnDivideDigit"))))
(loader'((fentry bnalloc subr1)
(entry bnalloc subr1)
(mov '4 a4)
(times a1 a4)
(mov '0 a2)
(mov a4 a1)
(jmp makestring)
))
(loader'((fentry bncreate subr2)
(entry bncreate subr2)
(push a1)
(mov '4 a4)
(times a2 a4)
(mov '0 a2)
(mov a4 a1)
(jcall makestring)
(push a1)
(push (@ 101))
(push a1)
(push (& 3))
(mov '2 a4)
(jmp typestring)
101
(eval ())
(mov (& 0) a1)
(adjstk '2)
(return)
))
(loader'((fentry bnfree subr1)
(entry bnfree subr1)
(mov '1 a1)
(return)
))
(loader'((fentry bngettype subr1)
(entry bngettype subr1)
(push (@ 101))
(push a1)
(mov '1 a4)
(jmp typestring)
101
(eval ())
(return)
))
(loader'((fentry bnsettype subr2)
(entry bnsettype subr2)
(push (@ 101))
(push a1)
(push a2)
(mov '2 a4)
(jmp typestring)
101
(eval ())
(return)
))
(loader'((fentry bngetsize subr1)
(entry bngetsize subr1)
(hgsize a1 a1)
(lshift '-2 a1)
(return)
))
(defvar #:kern:tampon (bncreate 'n 2))
(loader'((fentry #:n:prin subr1)
(entry #:n:prin subr1)
(push a1)
(push nil)
(push (@ 101))
(mov '0 a4)
(jmp obase)
101
(eval ())
(push a1)
(push (@ 102))
(push dlink)
(push prot)
(stack dlink)
(push (@ 104))
(push '16)
(mov '1 a4)
(jmp obase)
104
(eval ())
(mov (& 5) a1)
(jcall bngetsize)
(diff '1 a1)
(push a1)
105
(push (@ 107))
(push (& 1))
(push '0)
(mov '2 a4)
(jmp >=)
107
(eval ())
(btnil a1 106)
(push (@ 108))
(push (cvalq #:kern:tampon))
(push '0)
(push (& 9))
(push (& 4))
(push '1)
(mov '5 a4)
(jmp bnassign)
108
(eval ())
(mov '0 (& 5))
109
(push (@ 111))
(push (& 6))
(push (cvalq bn←digit←size))
(mov '2 a4)
(jmp <)
111
(eval ())
(btnil a1 110)
(push (@ 112))
(push (cvalq #:kern:tampon))
(push '0)
(push '1)
(push (cvalq #:kern:tampon))
(push '1)
(push '4)
(mov '6 a4)
(jmp bnshiftleft)
112
(eval ())
(push (@ 113))
(mov '1 a2)
(mov (cvalq #:kern:tampon) a1)
(jcall bngetdigit)
(push a1)
(mov '1 a4)
(jmp prin)
113
(eval ())
(push (@ 114))
(push (& 6))
(push '4)
(mov '2 a4)
(jmp +)
114
(eval ())
(mov a1 (& 5))
(bra 109)
110
(push (@ 115))
(push (& 1))
(push '-1)
(mov '2 a4)
(jmp +)
115
(eval ())
(mov a1 (& 0))
(bra 105)
106
(mov nil a1)
(adjstk '1)
(mov (& 1) dlink)
(adjstk '3)
(push a1)
(mov (@ 103) a3)
102
(push a3)
(push a2)
(push (@ 116))
(push (& 4))
(mov '1 a4)
(jmp obase)
116
(eval ())
(pop a2)
(pop a3)
(pop a1)
(bri a3)
103
(eval ())
(adjstk '3)
(return)
))
(loader '((end)))