(loader '((title |genr.lo|))) (if (not (>= (version) 15.2)) (progn (error 'load 'erricf 'genr))) (add-feature 'genr) (setq #:backup:majuscules #:system:read-case-flag #:system:read-case-flag ()) (setq #:sys-package:colon 'r) (loader'((fentry #:r:+ subr2) (entry #:r:+ subr2) (push a2) (jcall float) (push a1) (mov (& 1) a1) (jcall float) (pop a4) (fplus a1 a4) (mov a4 a1) (adjstk '1) (return) )) (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 a2) (jcall float) (push a1) (mov (& 1) a1) (jcall float) (pop a4) (ftimes a1 a4) (mov a4 a1) (adjstk '1) (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) )) (loader'((fentry #:r:<?> subr2) (entry #:r:<?> subr2) (push a2) (jcall float) (push a1) (mov (& 1) a1) (jcall float) (mov a1 a2) (pop a1) (adjstk '1) (jmp <?>) )) (defvar #:ex:mod 0) (loader'((fentry #:r:quomod subr2) (entry #:r:quomod subr2) (push a2) (push a1) (push (@ 101)) (push a1) (mov a2 a1) (jcall abs) (push a1) (mov '2 a4) (jmp /) 101 (eval ()) (jcall floor) (push a1) (push (@ 102)) (push (& 2)) (push (@ 103)) (mov (& 5) a1) (jcall abs) (push a1) (push (& 4)) (mov '2 a4) (jmp *) 103 (eval ()) (push a1) (mov '2 a4) (jmp -) 102 (eval ()) (mov a1 (cvalq #:ex:mod)) (push (@ 106)) (push (& 3)) (push '0) (mov '2 a4) (jmp <) 106 (eval ()) (btnil a1 104) (push (@ 107)) (push (& 1)) (mov '1 a4) (jmp -) 107 (eval ()) (adjstk '3) (return) 104 (mov (& 0) a1) (adjstk '3) (return) )) (loader'((fentry #:r:power subr2) (entry #:r:power subr2) (push (@ 101)) (push a2) (jcall log) (push a1) (mov '2 a4) (jmp *) 101 (eval ()) (jmp exp) )) (loader'((fentry ** subr2) (entry ** subr2) (push a2) (push a1) (push (@ 103)) (push a2) (push '0) (mov '2 a4) (jmp <) 103 (eval ()) (btnil a1 101) (push (@ 104)) (push (@ 105)) (push (& 3)) (mov '1 a4) (jmp -) 105 (eval ()) (mov a1 a2) (mov (& 1) a1) (jcall **) (push a1) (mov '1 a4) (jmp /) 104 (eval ()) (adjstk '2) (return) 101 (mov (& 1) a1) (jcall integerp) (btnil a1 106) (mov '1 a3) (mov (& 1) a2) (mov (& 0) a1) (adjstk '2) (bra #:r:**n) 106 (cabne (& 0) '0 108) (cabne '0 (& 1) 110) (push (@ 112)) (push '0) (push '0) (mov '2 a4) (jmp /) 112 (eval ()) (adjstk '2) (return) 110 (mov '0 a1) (adjstk '2) (return) 108 (cabne '1 (& 0) 113) (mov '1 a1) (adjstk '2) (return) 113 (mov (& 1) a2) (mov (& 0) a1) (adjstk '2) (jmp power) )) (loader'((entry #:r:**n subr3) (push a3) (push a2) (push a1) (cabne '0 a2 101) (mov a3 a1) (adjstk '3) (return) 101 (push (@ 103)) (push a1) (push a1) (mov '2 a4) (jmp *) 103 (eval ()) (push a1) (mov '2 a2) (mov (& 2) a1) (jcall quomod) (push a1) (cabne '0 (cvalq #:ex:mod) 104) (mov (& 4) a3) (bra 105) 104 (push (@ 106)) (push (& 3)) (push (& 6)) (mov '2 a4) (jmp *) 106 (eval ()) (mov a1 a3) 105 (pop a2) (pop a1) (adjstk '3) (bra #:r:**n) )) (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 #:r:0- subr1) (entry #:r:0- subr1) (jcall float) (jmp 0-) )) (loader'((fentry #:r:1/ subr1) (entry #:r:1/ subr1) (jcall float) (jmp 1/) )) (loader'((fentry #:r:truncate subr1) (entry #:r:truncate subr1) (jcall float) (jmp truncate) )) (loader'((fentry #:r:exp subr1) (entry #:r:exp subr1) (jcall float) (jmp exp) )) (loader'((fentry #:r:log subr1) (entry #:r:log subr1) (push a1) (push (@ 103)) (push a1) (push '0.) (mov '2 a4) (jmp <) 103 (eval ()) (btnil a1 101) (mov (& 0) a3) (mov (cvalq errgen) a2) (mov '"log" a1) (adjstk '1) (jmp error) 101 (mov (& 0) a1) (jcall float) (adjstk '1) (jmp log) )) (loader'((fentry #:r:sqrt subr1) (entry #:r:sqrt subr1) (push a1) (push (@ 103)) (push a1) (push '0.) (mov '2 a4) (jmp <) 103 (eval ()) (btnil a1 101) (mov (& 0) a3) (mov (cvalq errgen) a2) (mov '"sqrt" a1) (adjstk '1) (jmp error) 101 (mov (& 0) a1) (jcall float) (adjstk '1) (jmp sqrt) )) (loader'((fentry #:r:atan subr1) (entry #:r:atan subr1) (jcall float) (jmp atan) )) (loader'((fentry #:r:sin subr1) (entry #:r:sin subr1) (jcall float) (jmp sin) )) (loader'((fentry #:r:asin subr1) (entry #:r:asin subr1) (push a1) (push (@ 104)) (push a1) (push '-1.) (mov '2 a4) (jmp <) 104 (eval ()) (bfnil a1 103) (push (@ 105)) (push (& 1)) (push '1.) (mov '2 a4) (jmp >) 105 (eval ()) (btnil a1 101) 103 (mov (& 0) a3) (mov (cvalq errgen) a2) (mov '"asin" a1) (adjstk '1) (jmp error) 101 (mov (& 0) a1) (jcall float) (adjstk '1) (jmp asin) )) (loader'((fentry #:r:cos subr1) (entry #:r:cos subr1) (jcall float) (jmp cos) )) (loader'((fentry #:r:acos subr1) (entry #:r:acos subr1) (push a1) (push (@ 104)) (push a1) (push '-1.) (mov '2 a4) (jmp <) 104 (eval ()) (bfnil a1 103) (push (@ 105)) (push (& 1)) (push '1.) (mov '2 a4) (jmp >) 105 (eval ()) (btnil a1 101) 103 (mov (& 0) a3) (mov (cvalq errgen) a2) (mov '"acos" a1) (adjstk '1) (jmp error) 101 (mov (& 0) a1) (jcall float) (adjstk '1) (jmp acos) )) (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) )) (loader'((fentry #:float:<?> subr2) (entry #:float:<?> subr2) (push a1) (mov a2 a1) (jcall float) (mov (& 0) a2) (jcall <?>) (adjstk '1) (jmp 0-) )) (loader'((fentry #:fix:<?> subr2) (entry #:fix:<?> subr2) (push a2) (mov a1 a2) (pop a1) (jcall <?>) (jmp 0-) )) (defvar #:sys-package:genarith 'r) (setq #:system:read-case-flag #:backup:majuscules) (loader '((end)))