(loader '((title |bngen.lo|)))
(if (not (>= (version) 15.2)) (progn (error 'load 'errifc 'gen)))
(if (not (featurep 'kern)) (progn (loadmodule 'bnkern)))
(add-feature 'gen)
(setq #:backup:majuscules #:system:read-case-flag #:system:read-case-flag ())
(setq #:sys-package:colon 'r)
(loader'((fentry #:r:- subr2)
(entry #:r:- subr2)
(push (@ 101))
(push a1)
(mov a2 a1)
(jcall 0-)
(push a1)
(mov '2 a4)
(jmp +)
101
(eval ())
(return)
))
(loader'((fentry #:r:/ subr2)
(entry #:r:/ subr2)
(push (@ 101))
(push a1)
(mov a2 a1)
(jcall 1/)
(push a1)
(mov '2 a4)
(jmp *)
101
(eval ())
(return)
))
(defvar #:ex:mod 0)
(loader'((fentry #:r:quomod subr2)
(entry #:r:quomod subr2)
(push a2)
(push a1)
(mov a2 a1)
(jcall abs)
(push a1)
(push (@ 101))
(push (& 2))
(push a1)
(mov '2 a4)
(jmp /)
101
(eval ())
(jcall floor)
(push a1)
(push (@ 102))
(push (cvalq #:ex:mod))
(push (& 3))
(mov '2 a4)
(jmp *)
102
(eval ())
(mov a1 (cvalq #:ex:mod))
(push (@ 105))
(push (& 4))
(push '0)
(mov '2 a4)
(jmp <)
105
(eval ())
(btnil a1 103)
(mov (& 0) a1)
(adjstk '4)
(jmp 0-)
103
(mov (& 0) a1)
(adjstk '4)
(return)
))
(loader'((fentry #:r:eval subr1)
(entry #:r:eval subr1)
(return)
))
(loader'((fentry #:r:numberp subr1)
(entry #:r:numberp subr1)
(return)
))
(loader'((fentry #:r:integerp subr1)
(entry #:r:integerp subr1)
(mov nil a1)
(return)
))
(loader'((fentry #:r:rationalp subr1)
(entry #:r:rationalp subr1)
(mov nil a1)
(return)
))
(loader'((fentry floor subr1)
(entry floor subr1)
(push a1)
(jcall numberp)
(bfnil a1 101)
(mov (& 0) a3)
(mov 'errnna a2)
(mov 'floor a1)
(adjstk '1)
(jmp #:r:error)
101
(mov (& 0) a1)
(jcall integerp)
(btnil a1 103)
(mov '0 (cvalq #:ex:mod))
(mov (& 0) a1)
(adjstk '1)
(return)
103
(push (@ 105))
(push 'floor)
(push (& 2))
(mov '2 a4)
(jmp send)
105
(eval ())
(adjstk '1)
(return)
))
(loader'((fentry #:r:truncate subr1)
(entry #:r:truncate subr1)
(push a1)
(push (@ 101))
(push 'floor)
(push a1)
(mov '2 a4)
(jmp send)
101
(eval ())
(mov a1 (& 0))
(push (@ 104))
(push a1)
(push '0)
(mov '2 a4)
(jmp <)
104
(eval ())
(btnil a1 103)
(push (@ 105))
(push '1)
(push (& 2))
(mov '2 a4)
(jmp +)
105
(eval ())
(mov a1 (& 0))
(push (@ 106))
(push (cvalq #:ex:mod))
(push '1)
(mov '2 a4)
(jmp -)
106
(eval ())
(mov a1 (cvalq #:ex:mod))
103
(mov (& 0) a1)
(adjstk '1)
(return)
))
(loader'((fentry ceiling subr1)
(entry ceiling subr1)
(push a1)
(jcall floor)
(push (cvalq z))
(mov a1 (cvalq z))
(push '1)
(push '(z))
(push 'lambda)
(push llink)
(push dlink)
(push cbindn)
(stack dlink)
(push (@ 103))
(push a1)
(push (& 9))
(mov '2 a4)
(jmp <)
103
(eval ())
(btnil a1 101)
(push (@ 104))
(push (cvalq z))
(push '1)
(mov '2 a4)
(jmp +)
104
(eval ())
(bra 102)
101
(mov (cvalq z) a1)
102
(mov (& 1) dlink)
(mov (& 6) (cvalq z))
(adjstk '8)
(return)
))
(loader'((fentry round subr2)
(entry round subr2)
(push a2)
(push a1)
(push (@ 103))
(push a2)
(push '0)
(mov '2 a4)
(jmp <)
103
(eval ())
(btnil a1 101)
(mov (& 1) a1)
(jcall 0-)
(mov a1 a2)
(mov (& 0) a1)
(jcall round)
(adjstk '2)
(jmp 0-)
101
(push (@ 106))
(push (& 1))
(push '0)
(mov '2 a4)
(jmp <)
106
(eval ())
(btnil a1 104)
(push (@ 109))
(push (cvalq #:ex:mod))
(push (@ 110))
(push (& 4))
(push (cvalq #:ex:mod))
(mov '2 a4)
(jmp -)
110
(eval ())
(push a1)
(mov '2 a4)
(jmp =)
109
(eval ())
(btnil a1 107)
(push (@ 111))
(push '-1)
(mov (& 2) a1)
(jcall 0-)
(mov (& 3) a2)
(jcall round)
(push a1)
(mov '2 a4)
(jmp -)
111
(eval ())
(adjstk '2)
(return)
107
(mov (& 0) a1)
(jcall 0-)
(mov (& 1) a2)
(jcall round)
(jcall 0-)
(mov a1 (& 0))
(mov (cvalq #:ex:mod) a1)
(jcall 0-)
(mov a1 (cvalq #:ex:mod))
(mov (& 0) a1)
(adjstk '2)
(return)
104
(mov (& 1) a2)
(mov (& 0) a1)
(jcall quotient)
(mov a1 (& 0))
(push (@ 114))
(push (& 2))
(push (cvalq #:ex:mod))
(mov '2 a4)
(jmp -)
114
(eval ())
(mov a1 (& 1))
(btnil a1 112)
(push (@ 117))
(push a1)
(push (cvalq #:ex:mod))
(mov '2 a4)
(jmp <)
117
(eval ())
(btnil a1 115)
(mov (& 1) a1)
(jcall 0-)
(mov a1 (cvalq #:ex:mod))
(push (@ 118))
(push '1)
(push (& 2))
(mov '2 a4)
(jmp +)
118
(eval ())
(mov a1 (& 0))
(adjstk '2)
(return)
115
(mov (& 0) a1)
(adjstk '2)
(return)
112
(mov nil a1)
(adjstk '2)
(return)
))
(defvar #:r:prec t)
(loader'((fentry precision nsubr)
(entry precision nsubr)
(jcall #:llcp:nlist)
(btnil a1 102)
(mov (car a1) (cvalq #:r:prec))
102
(mov (cvalq #:r:prec) a1)
(return)
))
(loader'((fentry #:r:error subr3)
(entry #:r:error subr3)
(push a1)
(mov a2 a1)
(cabne a1 'rdiv0 102)
(mov '"Division entie`re par 0 : " a2)
(bra 101)
102
(cabne a1 'rnotz 103)
(mov '"L'argument n'est pas un entier: " a2)
(bra 101)
103
(cabne a1 'rnotc 104)
(mov '"Complexe mal forme'" a2)
(bra 101)
104
(cabne a1 'rinc 105)
(mov '"Argument Complexe" a2)
(bra 101)
105
(mov a1 a2)
101
(pop a1)
(jmp error)
))
(setq #:sys-package:colon 'float)
(loader'((fentry #:float:* subr2)
(entry #:float:* subr2)
(push (cvalq y))
(mov a2 (cvalq y))
(push (cvalq x))
(mov a1 (cvalq x))
(push '2)
(push '(y x))
(push (@ #:float:*))
(push llink)
(mov nil llink)
(push dlink)
(push cbindn)
(stack dlink)
(push a1)
(mov a2 a1)
(jcall float)
(pop a4)
(ftimes a1 a4)
(mov a4 a1)
(mov (& 1) dlink)
(mov (& 2) llink)
(mov (& 6) (cvalq x))
(mov (& 7) (cvalq y))
(adjstk '8)
(return)
))
(loader'((fentry #:float:+ subr2)
(entry #:float:+ subr2)
(push (cvalq y))
(mov a2 (cvalq y))
(push (cvalq x))
(mov a1 (cvalq x))
(push '2)
(push '(y x))
(push (@ #:float:+))
(push llink)
(mov nil llink)
(push dlink)
(push cbindn)
(stack dlink)
(push a1)
(mov a2 a1)
(jcall float)
(pop a4)
(fplus a1 a4)
(mov a4 a1)
(mov (& 1) dlink)
(mov (& 2) llink)
(mov (& 6) (cvalq x))
(mov (& 7) (cvalq y))
(adjstk '8)
(return)
))
(loader'((fentry #:float:<?> subr2)
(entry #:float:<?> subr2)
(push (cvalq y))
(mov a2 (cvalq y))
(push (cvalq x))
(mov a1 (cvalq x))
(push '2)
(push '(y x))
(push (@ #:float:<?>))
(push llink)
(mov nil llink)
(push dlink)
(push cbindn)
(stack dlink)
(push a1)
(mov a2 a1)
(jcall float)
(mov a1 a2)
(pop a1)
(jcall <?>)
(mov (& 1) dlink)
(mov (& 2) llink)
(mov (& 6) (cvalq x))
(mov (& 7) (cvalq y))
(adjstk '8)
(return)
))
(defvar #:float:b 32760)
(defvar #:float:fb (float #:float:b))
(defvar #:float:-fb (- #:float:fb))
(loader'((fentry #:float:quomod subr2)
(entry #:float:quomod subr2)
(push a2)
(push a1)
(mov a2 a1)
(jcall float)
(mov a1 (& 1))
(mov (& 0) a4)
(fquo a1 a4)
(mov a4 a1)
(jcall #:float:truncate)
(push a1)
(jcall float)
(mov (& 1) a4)
(ftimes a1 a4)
(mov (& 1) a3)
(fdiff a4 a3)
(mov a3 (cvalq #:ex:mod))
(mov (& 0) a1)
(adjstk '3)
(return)
))
(loader'((fentry #:float:floor subr1)
(entry #:float:floor subr1)
(jmp #:float:truncate)
))
(loader'((fentry #:float:truncate subr1)
(entry #:float:truncate subr1)
(push a1)
(push (@ 103))
(push a1)
(push '0)
(mov '2 a4)
(jmp <)
103
(eval ())
(btnil a1 101)
(push (@ 104))
(push (@ 105))
(push (& 2))
(mov '1 a4)
(jmp -)
105
(eval ())
(jcall #:float:truncate)
(push a1)
(mov '1 a4)
(jmp -)
104
(eval ())
(adjstk '1)
(return)
101
(mov (& 0) a1)
(adjstk '1)
(bra ftrunc)
))
(loader'((entry ftrunc subr1)
(push a1)
(push (@ 103))
(push (cvalq #:float:-fb))
(push a1)
(push (cvalq #:float:fb))
(mov '3 a4)
(jmp <)
103
(eval ())
(btnil a1 101)
(mov (& 0) a1)
(adjstk '1)
(jmp fix)
101
(mov (& 0) a4)
(fquo (cvalq #:float:fb) a4)
(mov a4 a1)
(call ftrunc)
(push a1)
(push (@ 104))
(push (& 2))
(push (@ 105))
(push a1)
(push (cvalq #:float:fb))
(mov '2 a4)
(jmp *)
105
(eval ())
(push a1)
(mov '2 a4)
(jmp -)
104
(eval ())
(push a1)
(push (@ 106))
(push (@ 107))
(push (& 3))
(push (cvalq #:float:b))
(mov '2 a4)
(jmp *)
107
(eval ())
(push a1)
(mov (& 2) a1)
(call ftrunc)
(push a1)
(mov '2 a4)
(jmp +)
106
(eval ())
(adjstk '3)
(return)
))
(loader'((fentry #:fix:<?> subr2)
(entry #:fix:<?> subr2)
(push (cvalq y))
(mov a2 (cvalq y))
(push (cvalq x))
(mov a1 (cvalq x))
(push '2)
(push '(y x))
(push (@ #:fix:<?>))
(push llink)
(mov nil llink)
(push dlink)
(push cbindn)
(stack dlink)
(push a2)
(mov a1 a2)
(pop a1)
(jcall <?>)
(jcall 0-)
(mov (& 1) dlink)
(mov (& 2) llink)
(mov (& 6) (cvalq x))
(mov (& 7) (cvalq y))
(adjstk '8)
(return)
))
(defvar #:sys-package:genarith 'r)
(setq #:system:read-case-flag #:backup:majuscules)
(loader '((end)))