(loader '((title bnkern16))) (defvar bn_digit_size 16) (if (not (>= (version) 15.2)) (progn (error 'load 'errifc 'kern))) (add-feature 'kern) (defvar #:backup:majuscules #:system:read-case-flag #:system:read-case-flag ()) (defvar #:ex:regret 0) (loader'((fentry bncreate subr2) (entry bncreate subr2) (push a1) (push a2) (mov '0 a2) (pop a1) (jcall makevector) (push a1) (push (@ 101)) (push a1) (push (& 3)) (mov '2 a4) (jmp typevector) 101 (eval ()) (mov (& 0) a1) (adjstk '2) (return) )) (loader'((fentry bnalloc subr1) (entry bnalloc subr1) (mov '0 a2) (jmp makevector) )) (loader'((fentry bnfree subr1) (entry bnfree subr1) (mov nil a1) (return) )) (loader'((fentry bngettype subr1) (entry bngettype subr1) (push (@ 101)) (push a1) (mov '1 a4) (jmp typevector) 101 (eval ()) (return) )) (loader'((fentry bnsettype subr2) (entry bnsettype subr2) (push (@ 101)) (push a1) (push a2) (mov '2 a4) (jmp typevector) 101 (eval ()) (return) )) (loader'((fentry bngetsize subr1) (entry bngetsize subr1) (hgsize a1 a1) (return) )) (loader'((fentry bnnumdigits subr3) (entry bnnumdigits subr3) (push a3) (push a2) (push a1) (cabne a3 '0 101) (mov '1 a1) (adjstk '3) (return) 101 (plus a3 a2) (mov a2 (& 2)) 103 (mov (& 2) a4) (diff '1 a4) (mov a4 (& 2)) (cnble a4 (& 1) 104) (hpxmov (& 0) a4 a3) (cabne '0 a3 104) (bra 103) 104 (mov (& 2) a4) (diff (& 1) a4) (plus '1 a4) (mov a4 a1) (adjstk '3) (return) )) (loader'((fentry bnassign nsubr) (entry bnassign nsubr) (cnbeq a4 '5 0) (mov 'bnassign a1) (mov '5 a2) (jmp #:llcp:errwna) 0 (push (@ 101)) (push (& 5)) (push (& 5)) (push (& 5)) (push (& 5)) (push (& 5)) (mov '5 a4) (jmp bltvector) 101 (eval ()) (adjstk '5) (return) )) (loader'((fentry bnsettozero subr3) (entry bnsettozero subr3) (push a3) (push a2) (push a1) 101 (mov (& 2) a4) (diff '1 a4) (mov a4 (& 2)) (cnblt a4 '0 102) (hpmovx '0 (& 0) (& 1)) (mov (& 1) a3) (plus '1 a3) (mov a3 (& 1)) (bra 101) 102 (mov nil a1) (adjstk '3) (return) )) (loader'((fentry bnsetdigit subr3) (entry bnsetdigit subr3) (hpmovx a3 a1 a2) (mov a3 a1) (return) )) (loader'((fentry bndoesdigitfitinword subr2) (entry bndoesdigitfitinword subr2) (hpxmov a1 a2 a4) (cnblt a4 '0 101) (mov '1 a1) (return) 101 (mov '0 a1) (return) )) (loader'((fentry bngetdigit subr2) (entry bngetdigit subr2) (hpxmov a1 a2 a1) (return) )) (loader'((fentry bncomparedigits nsubr) (entry bncomparedigits nsubr) (cnbeq a4 '4 0) (mov 'bncomparedigits a1) (mov '4 a2) (jmp #:llcp:errwna) 0 (hpxmov (& 3) (& 2) a1) (hpxmov (& 1) (& 0) a2) (adjstk '4) (jmp ex?) )) (loader'((fentry bnisdigitzero subr2) (entry bnisdigitzero subr2) (hpxmov a1 a2 a4) (cabne '0 a4 101) (mov '1 a1) (return) 101 (mov '0 a1) (return) )) (loader'((fentry bncomplement subr3) (entry bncomplement subr3) (push a3) (push a2) (push a1) 101 (mov (& 2) a4) (diff '1 a4) (mov a4 (& 2)) (cnblt a4 '0 102) (hpxmov (& 0) (& 1) a1) (jcall ex-) (hpmovx a1 (& 0) (& 1)) (mov (& 1) a4) (plus '1 a4) (mov a4 (& 1)) (bra 101) 102 (mov nil a1) (adjstk '3) (return) )) (loader'((fentry bnadd nsubr) (entry bnadd nsubr) (cnbeq a4 '7 0) (mov 'bnadd a1) (mov '7 a2) (jmp #:llcp:errwna) 0 (mov (& 0) (cvalq #:ex:regret)) (mov (& 4) a4) (diff (& 1) a4) (mov a4 (& 4)) 101 (mov (& 1) a4) (diff '1 a4) (mov a4 (& 1)) (cnblt a4 '0 102) (hpxmov (& 6) (& 5) a1) (hpxmov (& 3) (& 2) a2) (jcall ex+) (hpmovx a1 (& 6) (& 5)) (mov (& 2) a4) (plus '1 a4) (mov a4 (& 2)) (mov (& 5) a3) (plus '1 a3) (mov a3 (& 5)) (bra 101) 102 (push (@ 103)) (push (& 7)) (push (& 7)) (push (& 7)) (push (cvalq #:ex:regret)) (mov '4 a4) (jmp bnaddcarry) 103 (eval ()) (adjstk '7) (return) )) (loader'((fentry bnaddcarry nsubr) (entry bnaddcarry nsubr) (cnbeq a4 '4 0) (mov 'bnaddcarry a1) (mov '4 a2) (jmp #:llcp:errwna) 0 (mov (& 0) (cvalq #:ex:regret)) 101 (cabeq (cvalq #:ex:regret) '0 102) (mov (& 1) a4) (diff '1 a4) (mov a4 (& 1)) (cnblt a4 '0 102) (hpxmov (& 3) (& 2) a1) (mov '0 a2) (jcall ex+) (hpmovx a1 (& 3) (& 2)) (mov (& 2) a4) (plus '1 a4) (mov a4 (& 2)) (bra 101) 102 (mov '0 a2) (mov '0 a1) (adjstk '4) (jmp ex+) )) (loader'((fentry bnsubtract nsubr) (entry bnsubtract nsubr) (cnbeq a4 '7 0) (mov 'bnsubtract a1) (mov '7 a2) (jmp #:llcp:errwna) 0 (mov (& 1) a3) (mov (& 2) a2) (mov (& 3) a1) (jcall bncomplement) (push (@ 101)) (push (& 7)) (push (& 7)) (push (& 4)) (push (& 7)) (push (& 7)) (push (& 7)) (push (& 7)) (mov '7 a4) (jmp bnadd) 101 (eval ()) (mov a1 (& 0)) (mov (& 1) a3) (mov (& 2) a2) (mov (& 3) a1) (jcall bncomplement) (push (@ 102)) (push (& 7)) (mov (& 7) a4) (plus (& 3) a4) (push a4) (mov (& 7) a4) (diff (& 4) a4) (push a4) (push (& 4)) (mov '4 a4) (jmp bnsubtractborrow) 102 (eval ()) (adjstk '7) (return) )) (defvar #:n:c-1 ((lambda (res) (bncomplement res 0 1) res) (bncreate 'n 1))) (loader'((fentry bnsubtractborrow nsubr) (entry bnsubtractborrow nsubr) (cnbeq a4 '4 101) (mov 'bnsubtractborrow a1) (mov '4 a2) (jmp #:llcp:errwna) 101 (cnbne (& 0) '0 102) (mov (& 1) a1) (jcall 1-) (mov a1 (& 1)) (cnblt a1 '0 102) (push (@ 103)) (push (& 4)) (push (& 4)) (push '1) (push (cvalq #:n:c-1)) (push '0) (push '1) (push '0) (mov '7 a4) (jmp bnadd) 103 (eval ()) (mov a1 (& 0)) (mov (& 2) a1) (jcall 1+) (mov a1 (& 2)) (bra 101) 102 (mov (& 0) a1) (adjstk '4) (return) )) (loader'((fentry bnmultiplydigit nsubr) (entry bnmultiplydigit nsubr) (cnbeq a4 '8 0) (mov 'bnmultiplydigit a1) (mov '8 a2) (jmp #:llcp:errwna) 0 (hpxmov (& 1) (& 0) a4) (cabne a4 '0 101) (mov '0 a1) (adjstk '8) (return) 101 (hpxmov (& 1) (& 0) a4) (cabne a4 '1 106) (push (@ 105)) (push (& 8)) (push (& 8)) (push (& 8)) (push (& 8)) (push (& 8)) (push (& 8)) (push '0) (mov '7 a4) (jmp bnadd) 105 (eval ()) (adjstk '8) (return) 106 (mov (& 2) a4) (diff '1 a4) (mov a4 (& 2)) (cnblt a4 '0 108) (hpxmov (& 4) (& 3) a1) (hpxmov (& 1) (& 0) a2) (hpxmov (& 7) (& 6) a3) (jcall ex*) (hpmovx a1 (& 7) (& 6)) (mov (& 6) a4) (plus '1 a4) (mov a4 (& 6)) (mov (& 3) a3) (plus '1 a3) (mov a3 (& 3)) (mov (& 5) a2) (diff '1 a2) (mov a2 (& 5)) (bra 106) 108 (mov (& 5) a4) (diff '1 a4) (mov a4 (& 5)) (cnblt a4 '0 109) (hpxmov (& 7) (& 6) a1) (mov '0 a2) (jcall ex+) (hpmovx a1 (& 7) (& 6)) (mov (& 6) a4) (plus '1 a4) (mov a4 (& 6)) (bra 108) 109 (mov '0 a2) (mov '0 a1) (adjstk '8) (jmp ex+) )) (loader'((fentry bndividedigit nsubr) (entry bndividedigit nsubr) (cnbeq a4 '9 0) (mov 'bndividedigit a1) (mov '9 a2) (jmp #:llcp:errwna) 0 (mov (& 7) a4) (plus (& 2) a4) (diff '1 a4) (push a4) (hpxmov (& 2) (& 1) a3) (push a3) (mov (& 4) a2) (mov 'n a1) (jcall bncreate) (push (& 4)) (push a1) (push (@ 101)) (push a1) (push '0) (push (& 11)) (push (& 11)) (push (& 11)) (mov '5 a4) (jmp bnassign) 101 (eval ()) (mov (& 1) a4) (diff '1 a4) (mov a4 (& 1)) (hpxmov (& 0) a4 a4) (mov a4 (cvalq #:ex:regret)) 102 (mov (& 1) a4) (diff '1 a4) (mov a4 (& 1)) (cnblt a4 '0 103) (mov (& 3) a3) (diff '1 a3) (mov a3 (& 3)) (push a3) (hpxmov (& 1) a4 a1) (mov (& 3) a2) (jcall ex/) (pop a4) (hpmovx a1 (& 12) a4) (bra 102) 103 (mov '0 a2) (mov '0 a1) (jcall ex+) (hpmovx a1 (& 10) (& 9)) (adjstk '13) (return) )) (loader'((fentry bnshiftleft nsubr) (entry bnshiftleft nsubr) (cnbeq a4 '6 0) (mov 'bnshiftleft a1) (mov '6 a2) (jmp #:llcp:errwna) 0 (mov (& 3) a4) (plus '1 a4) (mov a4 a2) (mov 'n a1) (jcall bncreate) (push a1) (mov '1 a2) (mov 'n a1) (jcall bncreate) (push '1) (push '0) (push a1) (mov (& 4) a4) (bra 102) 101 (push a4) (mov (& 3) a4) (times '2 a4) (mov a4 (& 3)) (pop a4) 102 (sobgez a4 101) (mov (& 2) a3) (mov '0 a2) (mov (& 0) a1) (jcall bnsetdigit) (push (@ 103)) (push (& 4)) (push '0) (mov (& 10) a4) (plus '1 a4) (push a4) (push (& 13)) (push (& 13)) (push (& 13)) (push (& 7)) (push '0) (mov '8 a4) (jmp bnmultiplydigit) 103 (eval ()) (push (@ 104)) (push (& 10)) (push (& 10)) (push (& 6)) (push '0) (push (& 12)) (mov '5 a4) (jmp bnassign) 104 (eval ()) (push (@ 105)) (push (& 7)) (push (& 7)) (push (& 6)) (push (& 11)) (push '1) (mov '5 a4) (jmp bnassign) 105 (eval ()) (adjstk '10) (return) )) (loader'((fentry bnshiftright nsubr) (entry bnshiftright nsubr) (cnbeq a4 '6 0) (mov 'bnshiftright a1) (mov '6 a2) (jmp #:llcp:errwna) 0 (mov '1 a2) (mov 'n a1) (jcall bncreate) (push a1) (mov (& 4) a4) (plus '1 a4) (mov a4 a2) (mov 'n a1) (jcall bncreate) (push '1) (push a1) (cnbne (& 3) '0 101) (hpmovx '0 (& 5) (& 4)) (mov '0 a1) (adjstk '9) (return) 101 (mov (& 3) a4) (bra 104) 103 (push a4) (mov (& 2) a4) (times '2 a4) (mov a4 (& 2)) (pop a4) 104 (sobgez a4 103) (mov (& 1) a3) (mov '0 a2) (mov (& 2) a1) (jcall bnsetdigit) (push (@ 105)) (push (& 1)) (push '0) (push (& 11)) (push (& 11)) (push (& 11)) (mov '5 a4) (jmp bnassign) 105 (eval ()) (push (@ 106)) (push (& 9)) (push (& 9)) (push (& 8)) (push (& 8)) (push (& 5)) (push '0) (mov (& 13) a4) (plus '1 a4) (push a4) (push (& 10)) (push '0) (mov '9 a4) (jmp bndividedigit) 106 (eval ()) (mov (cvalq bn_digit_size) a4) (diff (& 3) a4) (mov a4 (& 3)) (hpxmov (& 5) (& 4) a3) (lshift a4 a3) (hpmovx a3 (& 5) (& 4)) (mov a3 a1) (adjstk '9) (return) )) (loader'((fentry bnanddigits nsubr) (entry bnanddigits nsubr) (cnbeq a4 '4 0) (mov 'bnanddigits a1) (mov '4 a2) (jmp #:llcp:errwna) 0 (hpxmov (& 3) (& 2) a4) (hpxmov (& 1) (& 0) a3) (land a3 a4) (hpmovx a4 (& 3) (& 2)) (mov a4 a1) (adjstk '4) (return) )) (loader'((fentry bnordigits nsubr) (entry bnordigits nsubr) (cnbeq a4 '4 0) (mov 'bnordigits a1) (mov '4 a2) (jmp #:llcp:errwna) 0 (hpxmov (& 3) (& 2) a4) (hpxmov (& 1) (& 0) a3) (lor a3 a4) (hpmovx a4 (& 3) (& 2)) (mov a4 a1) (adjstk '4) (return) )) (loader'((fentry bnxordigits nsubr) (entry bnxordigits nsubr) (cnbeq a4 '4 0) (mov 'bnxordigits a1) (mov '4 a2) (jmp #:llcp:errwna) 0 (hpxmov (& 3) (& 2) a4) (hpxmov (& 1) (& 0) a3) (lxor a3 a4) (hpmovx a4 (& 3) (& 2)) (mov a4 a1) (adjstk '4) (return) )) (loader'((fentry bnisdigitodd subr2) (entry bnisdigitodd subr2) (hpxmov a1 a2 a1) (jcall oddp) (btnil a1 101) (mov '1 a1) (return) 101 (mov '0 a1) (return) )) (loader'((fentry bnnumleadingzerobitsindigit subr2) (entry bnnumleadingzerobitsindigit subr2) (hpxmov a1 a2 a4) (push '0) (push a4) (cabne a4 '0 103) (mov (cvalq bn_digit_size) a1) (adjstk '2) (return) 103 (cnblt (& 0) '0 104) (mov (& 0) a4) (times '2 a4) (mov a4 (& 0)) (mov (& 1) a4) (plus '1 a4) (mov a4 (& 1)) (bra 103) 104 (mov (& 1) a1) (adjstk '2) (return) )) (loader'((fentry bnisdigitnormalized subr2) (entry bnisdigitnormalized subr2) (hpxmov a1 a2 a4) (cnblt a4 '0 101) (mov '0 a1) (return) 101 (mov '1 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) )) (setq #:system:read-case-flag #:backup:majuscules) (loader '((end)))