(loader '((title |countcalls.lo|))) (if (not (>= (version) 15.21)) (progn (error 'load 'erricf 'countcalls))) (add-feature 'countcalls) (setq #:sys-package:colon 'count-calls) (defvar #:count-calls:plist-indicator '#:count-calls:count-calls-indicator) (defvar #:count-calls:last-loc-for-system-functions (loc 'calln)) (defvar #:count-calls:active-flag ()) (defvar #:count-calls:debug-flag ()) (loader '((fentry #:count-calls:fincrplist fsubr) (mov (car a1) a1) (jmp #:count-calls:incrplist) (fentry #:count-calls:incrplist subr1) (cabeq nil (cvalq #:count-calls:active-flag) 101) (bfvar a1 101) (mov (plist a1) a1) (call 104) 101 (mov nil a1) (return) 103 (mov (cdr a1) a1) (bfcons a1 105) (mov (cdr a1) a1) 104 (bfcons a1 105) (cabne (car a1) (cvalq #:count-calls:plist-indicator) 103) (mov (cdr a1) a1) (bfcons a1 105) (fplus '1. (car a1)) 105 (return) (end))) (loader'((fentry count-calls-init subr0) (entry count-calls-init subr0) (push nil) (push (cvalq #:count-calls:active-flag)) (mov (& 1) (cvalq #:count-calls:active-flag)) (push '1) (push '(#:count-calls:active-flag)) (push 'lambda) (push llink) (push dlink) (push cbindn) (stack dlink) (bra 101) (fentry #:count-calls-init:g107 subr1) (entry #:count-calls-init:g107 subr1) (push a1) (mov (cvalq #:count-calls:plist-indicator) a2) (jcall getprop) (btnil a1 102) (mov (cvalq #:count-calls:plist-indicator) a3) (mov '0. a2) (mov (& 0) a1) (adjstk '1) (jmp putprop) 102 (mov (& 0) a1) (adjstk '1) (bra #:count-calls:count-calls-init1) 101 (mov '#:count-calls-init:g107 a1) (jcall mapoblist) (mov (& 1) dlink) (mov (& 6) (cvalq #:count-calls:active-flag)) (adjstk '8) (jmp count-calls-start) )) (loader'((entry #:count-calls:count-calls-init1 subr1) (push a1) (jcall typefn) (btnil a1 101) (push 't) (push (cvalq #:ld:special-case-loader)) (mov (& 1) (cvalq #:ld:special-case-loader)) (push '1) (push '(#:ld:special-case-loader)) (push 'lambda) (push llink) (push dlink) (push cbindn) (stack dlink) (mov (& 8) a4) (cabeq (pkgc a4) 'count-calls 105) (cabne (pkgc a4) 'llcp 103) (mov a4 a1) (jcall loc) (mov a1 a2) (mov (cvalq #:count-calls:last-loc-for-system-functions) a1) (jcall gtadr) (btnil a1 103) 105 (mov nil a1) (bra 104) 103 (btnil (cvalq #:count-calls:debug-flag) 107) (push (@ 108)) (push '#:count-calls:count-calls-init1) (push '" ") (push (& 11)) (mov '3 a4) (jmp print) 108 (eval ()) 107 (mov (cvalq #:count-calls:plist-indicator) a3) (mov '0. a2) (mov (& 8) a1) (jcall putprop) (mov (& 8) a1) (jcall typefn) (cabeq a1 'subr0 111) (cabeq a1 'subr1 111) (cabeq a1 'subr2 111) (cabeq a1 'subr3 111) (cabeq a1 'nsubr 111) (cabeq a1 'fsubr 111) (cabeq a1 'msubr 111) (cabne a1 'dmsubr 110) 111 (push (@ 112)) (push (@ 113)) (push (@ 114)) (push 'fentry) (push (& 12)) (mov (& 13) a1) (jcall typefn) (push a1) (mov '3 a4) (jmp list) 114 (eval ()) (push a1) (push '(push a1)) (push (@ 115)) (push 'mov) (push (@ 116)) (push 'quote) (push (& 16)) (mov '2 a4) (jmp list) 116 (eval ()) (push a1) (push '(a1)) (mov '3 a4) (jmp mcons) 115 (eval ()) (push a1) (push '(jcall #:count-calls:incrplist)) (push '(pop a1)) (push (@ 117)) (push 'bri) (push (@ 118)) (push 'eval) (push (@ 119)) (push 'kwote) (push (@ 120)) (push 'vag) (push (@ 121)) (push 'valfn) (push (@ 122)) (push 'quote) (push (& 27)) (mov '2 a4) (jmp list) 122 (eval ()) (push a1) (mov '2 a4) (jmp list) 121 (eval ()) (push a1) (mov '2 a4) (jmp list) 120 (eval ()) (push a1) (mov '2 a4) (jmp list) 119 (eval ()) (push a1) (mov '2 a4) (jmp list) 118 (eval ()) (push a1) (mov '2 a4) (jmp list) 117 (eval ()) (push a1) (push '((end))) (mov '7 a4) (jmp mcons) 113 (eval ()) (push a1) (mov '1 a4) (jmp loader) 112 (eval ()) (bra 104) 110 (cabeq a1 'expr 124) (cabeq a1 'fexpr 124) (cabeq a1 'macro 124) (cabne a1 'dmacro 123) 124 (mov (& 8) a1) (jcall valfn) (push a1) (mov (& 9) a1) (jcall typefn) (push a1) (push (@ 125)) (mov (& 2) a4) (push (car a4)) (push (@ 126)) (push '#:count-calls:fincrplist) (push (& 14)) (mov '2 a4) (jmp list) 126 (eval ()) (push a1) (mov (& 4) a4) (push (cdr a4)) (mov '3 a4) (jmp mcons) 125 (eval ()) (mov a1 a3) (pop a2) (mov (& 9) a1) (jcall resetfn) (adjstk '1) (bra 104) 123 (mov nil a1) 104 (mov (& 1) dlink) (mov (& 6) (cvalq #:ld:special-case-loader)) (adjstk '9) (return) 101 (mov nil a1) (adjstk '1) (return) )) (loader'((fentry count-calls-start subr0) (entry count-calls-start subr0) (mov 't (cvalq #:count-calls:active-flag)) (mov 't a1) (return) )) (loader'((fentry count-calls-stop subr0) (entry count-calls-stop subr0) (mov nil (cvalq #:count-calls:active-flag)) (mov nil a1) (return) )) (loader'((entry #:count-calls:get-count-calls-infos subr2) (push a1) (push (cvalq val-min)) (mov a2 (cvalq val-min)) (push '1) (push '(val-min)) (push (@ #:count-calls:get-count-calls-infos)) (push llink) (mov nil llink) (push dlink) (push cbindn) (stack dlink) (bfcons a2 101) (bffloat (car a2) 103) (push (@ 105)) (push (car a2)) (push '0.) (mov '2 a4) (jmp >=) 105 (eval ()) (btnil a1 103) (mov (cvalq val-min) a4) (mov (car a4) a4) (bra 102) 103 (mov (cvalq val-min) a3) (mov (car a3) a3) (mov 'erroob a2) (mov (& 7) a1) (jcall error) (mov a1 a4) (bra 102) 101 (mov '1. a4) 102 (mov a4 (cvalq val-min)) (push nil) (push (cvalq l)) (mov (& 1) (cvalq l)) (push '1) (push '(l)) (push 'lambda) (push llink) (push dlink) (push cbindn) (stack dlink) (bra 106) (fentry #:count-calls:get-count-calls-infos:g108 subr1) (entry #:count-calls:get-count-calls-infos:g108 subr1) (push a1) (mov (cvalq #:count-calls:plist-indicator) a2) (jcall getprop) (btnil a1 107) (bffloat a1 107) (cfbgt (cvalq val-min) a1 107) (push (@ 109)) (push (& 1)) (push a1) (mov (& 3) a1) (jcall typefn) (push a1) (mov '3 a4) (jmp list) 109 (eval ()) (mov (cvalq l) a2) (jcall cons) (mov a1 (cvalq l)) (adjstk '1) (return) 107 (mov nil a1) (adjstk '1) (return) 106 (mov '#:count-calls:get-count-calls-infos:g108 a1) (jcall mapoblist) (mov (cvalq l) a1) (mov (& 1) dlink) (mov (& 6) (cvalq l)) (adjstk '8) (mov (& 1) dlink) (mov (& 2) llink) (mov (& 6) (cvalq val-min)) (adjstk '8) (return) )) (loader'((fentry count-calls-infos nsubr) (entry count-calls-infos nsubr) (jcall #:llcp:nlist) (push nil) (push (cvalq #:count-calls:active-flag)) (mov (& 1) (cvalq #:count-calls:active-flag)) (push '1) (push '(#:count-calls:active-flag)) (push 'lambda) (push llink) (push dlink) (push cbindn) (stack dlink) (mov a1 a2) (mov 'count-calls-infos a1) (call #:count-calls:get-count-calls-infos) (mov (& 1) dlink) (mov (& 6) (cvalq #:count-calls:active-flag)) (adjstk '8) (return) )) (loader'((fentry count-calls-printn nsubr) (entry count-calls-printn nsubr) (jcall #:llcp:nlist) (push nil) (push (cvalq #:count-calls:active-flag)) (mov (& 1) (cvalq #:count-calls:active-flag)) (push '1) (push '(#:count-calls:active-flag)) (push 'lambda) (push llink) (push dlink) (push cbindn) (stack dlink) (mov a1 a2) (mov 'count-calls-printn a1) (call #:count-calls:get-count-calls-infos) (push a1) (bra 101) (fentry #:count-calls-printn:g109 subr2) (entry #:count-calls-printn:g109 subr2) (push (@ 102)) (mov (cdr a1) a4) (push (car a4)) (mov (cdr a2) a4) (push (car a4)) (mov '2 a4) (jmp >) 102 (eval ()) (return) 101 (mov a1 a2) (mov '#:count-calls-printn:g109 a1) (jcall sort) (mov a1 (& 0)) (push a1) 103 (bfcons (& 0) 104) (mov (& 0) a4) (mov (cdr a4) (& 0)) (push (car a4)) (push (@ 105)) (push '" ~8,0F ~6A ~A") (mov (& 2) a4) (mov (cdr a4) a4) (push (car a4)) (mov (& 3) a4) (mov (cdr a4) a4) (mov (cdr a4) a4) (push (car a4)) (mov (& 4) a4) (push (car a4)) (mov '4 a4) (jmp prinf) 105 (eval ()) (push (@ 106)) (mov '0 a4) (jmp terpri) 106 (eval ()) (adjstk '1) (bra 103) 104 (mov nil a1) (adjstk '2) (mov (& 1) dlink) (mov (& 6) (cvalq #:count-calls:active-flag)) (adjstk '8) (return) )) (loader'((fentry count-calls-printa nsubr) (entry count-calls-printa nsubr) (jcall #:llcp:nlist) (push nil) (push (cvalq #:count-calls:active-flag)) (mov (& 1) (cvalq #:count-calls:active-flag)) (push '1) (push '(#:count-calls:active-flag)) (push 'lambda) (push llink) (push dlink) (push cbindn) (stack dlink) (mov a1 a2) (mov 'count-calls-printa a1) (call #:count-calls:get-count-calls-infos) (push a1) (bra 101) (fentry #:count-calls-printa:g110 subr2) (entry #:count-calls-printa:g110 subr2) (mov (car a2) a2) (mov (car a1) a1) (jmp alphalessp) 101 (mov a1 a2) (mov '#:count-calls-printa:g110 a1) (jcall sort) (mov a1 (& 0)) (push a1) 102 (bfcons (& 0) 103) (mov (& 0) a4) (mov (cdr a4) (& 0)) (push (car a4)) (push (@ 104)) (push '" ~36A ~6@A ~8,0F ") (mov (& 2) a4) (push (car a4)) (mov (cdr a4) a4) (mov (cdr a4) a4) (push (car a4)) (mov (& 4) a4) (mov (cdr a4) a4) (push (car a4)) (mov '4 a4) (jmp prinf) 104 (eval ()) (push (@ 105)) (mov '0 a4) (jmp terpri) 105 (eval ()) (adjstk '1) (bra 102) 103 (mov nil a1) (adjstk '2) (mov (& 1) dlink) (mov (& 6) (cvalq #:count-calls:active-flag)) (adjstk '8) (return) )) (loader '((end)))