diff options
| -rw-r--r-- | share/txr/stdlib/asm.tl | 4 | ||||
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 35 | ||||
| -rw-r--r-- | vm.c | 42 |
3 files changed, 40 insertions, 41 deletions
diff --git a/share/txr/stdlib/asm.tl b/share/txr/stdlib/asm.tl index 74ba5866..1cbaba87 100644 --- a/share/txr/stdlib/asm.tl +++ b/share/txr/stdlib/asm.tl @@ -759,7 +759,7 @@ (let ((asm (new assembler buf code))) (put-line "data:") (mapdo (do format t " d~,03X: ~s\n" @1 @2) (range 0) data) - (put-line "funs:") + (put-line "syms:") (mapdo (do format t "~5d: ~s\n" @1 @2) (range 0) funv) (put-line "code:") (let ((ninsn asm.(dis-listing))) @@ -771,7 +771,7 @@ (typecase obj (vm-desc (disassemble-cdf (vm-desc-bytecode obj) (vm-desc-datavec obj) - (vm-desc-funvec obj) + (vm-desc-symvec obj) stream)) (fun (unless (vm-fun-p obj) (error "~s: not a vm function: ~s" self obj)) diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index abec279c..98b3fc4a 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -138,13 +138,13 @@ (defstruct compiler nil (treg-cntr 2) (dreg-cntr 0) - (fidx-cntr 0) + (sidx-cntr 0) (nlev 2) (tregs nil) (dreg (hash :eql-based)) (data (hash :eql-based)) - (fidx (hash :eql-based)) - (ftab (hash :eql-based)) + (sidx (hash :eql-based)) + (stab (hash :eql-based)) lt-frags last-form)) @@ -236,18 +236,18 @@ dreg) (compile-error me.last-form "code too complex: too many literals"))) -(defmeth compiler get-fidx (me atom) - (iflet ((fidx [me.fidx atom])) - fidx - (let* ((fidx (pinc me.fidx-cntr))) - (set [me.ftab fidx] atom) - (set [me.fidx atom] fidx)))) +(defmeth compiler get-sidx (me atom) + (iflet ((sidx [me.sidx atom])) + sidx + (let* ((sidx (pinc me.sidx-cntr))) + (set [me.stab sidx] atom) + (set [me.sidx atom] sidx)))) (defmeth compiler get-datavec (me) (vec-list [mapcar me.data (range* 0 me.dreg-cntr)])) -(defmeth compiler get-funvec (me) - (vec-list [mapcar me.ftab (range* 0 me.fidx-cntr)])) +(defmeth compiler get-symvec (me) + (vec-list [mapcar me.stab (range* 0 me.sidx-cntr)])) (defmeth compiler alloc-treg (me) (cond @@ -401,7 +401,7 @@ (compile-error form "assignment to lexical function binding") (let ((vfrag me.(compile oreg env val)) (fname me.(get-dreg sym)) - (rplcd me.(get-fidx 'usr:rplacd)) + (rplcd me.(get-sidx 'usr:rplacd)) (treg me.(alloc-treg))) me.(free-treg treg) (new (frag vfrag.oreg @@ -676,7 +676,7 @@ (lskip (gensym "l"))) (new (frag oreg ^((gcall ,treg - ,me.(get-fidx 'exception-subtype-p) + ,me.(get-sidx 'exception-subtype-p) ,esvb.loc ,me.(get-dreg sym)) (if ,treg ,lskip) @@ -998,7 +998,7 @@ ((bindable arg) (let ((fbind env.(lookup-fun arg t))) me.(comp-call-impl oreg env (if fbind opcode gopcode) - (if fbind fbind.loc me.(get-fidx arg)) + (if fbind fbind.loc me.(get-sidx arg)) (cdr args)))) ((and (consp arg) (eq (car arg) 'lambda)) me.(comp-fun-form oreg env ^(sym ,arg ,*(cdr args)))) @@ -1011,7 +1011,7 @@ (ift me.(comp-ift oreg env form)) (t (let* ((fbind env.(lookup-fun sym t)) (cfrag me.(comp-call-impl oreg env (if fbind 'call 'gcall) - (if fbind fbind.loc me.(get-fidx sym)) + (if fbind fbind.loc me.(get-sidx sym)) args))) (pushnew sym cfrag.ffuns) cfrag))))) @@ -1519,7 +1519,7 @@ co.(free-treg oreg) co.(check-treg-leak) as.(asm ^(,*(mappend .code (nreverse co.lt-frags)) ,*frag.code (end ,frag.oreg))) - (vm-make-desc co.nlev (succ as.max-treg) as.buf co.(get-datavec) co.(get-funvec))))) + (vm-make-desc co.nlev (succ as.max-treg) as.buf co.(get-datavec) co.(get-symvec))))) (defvarl %file-suff-rx% #/[.][^\\\/.]+/) @@ -1564,8 +1564,7 @@ (sys:vm-desc-nregs vd) (sys:vm-desc-bytecode vd) (copy (sys:vm-desc-datavec vd)) - (sys:vm-desc-funvec vd))) - + (sys:vm-desc-symvec vd))) (defmacro usr:with-compilation-unit (. body) (with-gensyms (rec) @@ -61,10 +61,10 @@ struct vm_desc { cnum ftsz; val bytecode; val datavec; - val funvec; + val symvec; vm_word_t *code; val *data; - struct vm_ftent *ftab; + struct vm_ftent *stab; }; struct vm_ftent { @@ -106,7 +106,7 @@ static struct vm_desc *vm_desc_struct(val obj) } val vm_make_desc(val nlevels, val nregs, val bytecode, - val datavec, val funvec) + val datavec, val symvec) { val self = lit("sys:vm-make-desc"); int nlvl = c_int(nlevels, self), nreg = c_int(nregs, self); @@ -122,24 +122,24 @@ val vm_make_desc(val nlevels, val nregs, val bytecode, { mem_t *code = buf_get(bytecode, self); val dvl = length_vec(datavec); - cnum ftsz = c_num(length_vec(funvec)); + cnum ftsz = c_num(length_vec(symvec)); loc data_loc = if3(dvl != zero, vecref_l(datavec, zero), nulloc); struct vm_desc *vd = coerce(struct vm_desc *, chk_malloc(sizeof *vd)); - struct vm_ftent *ftab = if3(ftsz != 0, + struct vm_ftent *stab = if3(ftsz != 0, coerce(struct vm_ftent *, - chk_calloc(ftsz, sizeof *ftab)), 0); + chk_calloc(ftsz, sizeof *stab)), 0); val desc; vd->nlvl = nlvl; vd->nreg = nreg; vd->code = coerce(vm_word_t *, code); vd->data = valptr(data_loc); - vd->ftab = ftab; + vd->stab = stab; vd->ftsz = ftsz; vd->bytecode = nil; vd->datavec = nil; - vd->funvec = nil; + vd->symvec = nil; vd->frsz = nlvl * 2 + nreg; @@ -149,7 +149,7 @@ val vm_make_desc(val nlevels, val nregs, val bytecode, vd->bytecode = bytecode; vd->datavec = datavec; - vd->funvec = funvec; + vd->symvec = symvec; vd->self = desc; return desc; @@ -180,16 +180,16 @@ static val vm_desc_datavec(val desc) return vd->datavec; } -static val vm_desc_funvec(val desc) +static val vm_desc_symvec(val desc) { struct vm_desc *vd = vm_desc_struct(desc); - return vd->funvec; + return vd->symvec; } static void vm_desc_destroy(val obj) { struct vm_desc *vd = coerce(struct vm_desc *, obj->co.handle); - free(vd->ftab); + free(vd->stab); free(vd); } @@ -200,10 +200,10 @@ static void vm_desc_mark(val obj) gc_mark(vd->bytecode); gc_mark(vd->datavec); - gc_mark(vd->funvec); + gc_mark(vd->symvec); for (i = 0; i < ftsz; i++) - gc_mark(vd->ftab[i].fb); + gc_mark(vd->stab[i].fb); } static struct vm_closure *vm_closure_struct(val obj) @@ -470,19 +470,19 @@ NOINLINE static void vm_apply(struct vm *vm, vm_word_t insn) vm_set(vm->dspl, dest, result); } -static loc vm_ftab(struct vm *vm, unsigned fun) +static loc vm_stab(struct vm *vm, unsigned fun) { struct vm_desc *vd = vm->vd; - struct vm_ftent *fe = &vd->ftab[fun]; + struct vm_ftent *fe = &vd->stab[fun]; loc fbloc = fe->fbloc; if (!nullocp(fbloc)) return fbloc; - if (nilp(fe->fb = lookup_fun(nil, vecref(vd->funvec, num_fast(fun))))) + if (nilp(fe->fb = lookup_fun(nil, vecref(vd->symvec, num_fast(fun))))) eval_error(vd->bytecode, lit("function ~s is not defined"), - vecref(vd->funvec, num(fun)), nao); + vecref(vd->symvec, num(fun)), nao); gc_mutated(vd->self); return (fe->fbloc = cdr_l(fe->fb)); } @@ -512,7 +512,7 @@ NOINLINE static void vm_gcall(struct vm *vm, vm_word_t insn) } } - result = generic_funcall(deref(vm_ftab(vm, fun)), args); + result = generic_funcall(deref(vm_stab(vm, fun)), args); vm_set(vm->dspl, dest, result); } @@ -541,7 +541,7 @@ NOINLINE static void vm_gapply(struct vm *vm, vm_word_t insn) } } - result = applyv(deref(vm_ftab(vm, fun)), args); + result = applyv(deref(vm_stab(vm, fun)), args); vm_set(vm->dspl, dest, result); } @@ -1104,7 +1104,7 @@ void vm_init(void) reg_fun(intern(lit("vm-desc-nregs"), system_package), func_n1(vm_desc_nregs)); reg_fun(intern(lit("vm-desc-bytecode"), system_package), func_n1(vm_desc_bytecode)); reg_fun(intern(lit("vm-desc-datavec"), system_package), func_n1(vm_desc_datavec)); - reg_fun(intern(lit("vm-desc-funvec"), system_package), func_n1(vm_desc_funvec)); + reg_fun(intern(lit("vm-desc-symvec"), system_package), func_n1(vm_desc_symvec)); reg_fun(intern(lit("vm-execute-toplevel"), system_package), func_n1(vm_execute_toplevel)); reg_fun(intern(lit("vm-closure-desc"), system_package), func_n1(vm_closure_desc)); reg_fun(intern(lit("vm-closure-entry"), system_package), func_n1(vm_closure_entry)); |