mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

Remove free-ref, free-set!

Browse source 
* libguile/vm-engine.c (free-ref, free-set!): Remove ops.
* module/language/cps/effects-analysis.scm:
* module/system/vm/assembler.scm:
* module/system/vm/disassembler.scm (code-annotation):
* module/language/cps/compile-bytecode.scm (compile-function): Remove
  support for free-ref / free-set!.
This commit is contained in:
Andy Wingo 2018-01-22 07:49:19 +01:00
parent fcea9eeabd
commit b09bbfe3c0
5 changed files with 4 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

33
libguile/vm-engine.c
View file

@ -322,8 +322,6 @@
VM_VALIDATE (x, SCM_CHARP, proc, char)
#define VM_VALIDATE_STRING(obj, proc) \
VM_VALIDATE (obj, scm_is_string, proc, string)
#define VM_VALIDATE_VARIABLE(obj, proc) \
VM_VALIDATE (obj, SCM_VARIABLEP, proc, variable)
#define VM_VALIDATE_INDEX(u64, size, proc) \
VM_ASSERT (u64 < size, vm_error_out_of_range_uint64 (proc, u64))
@ -1536,34 +1534,11 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
NEXT (3);
}
/* free-ref dst:12 src:12 _:8 idx:24
*
* Load free variable IDX from the closure SRC into local slot DST.
*/
VM_DEFINE_OP (55, free_ref, "free-ref", OP2 (X8_S12_S12, X8_C24) | OP_DST)
VM_DEFINE_OP (55, unused_55, NULL, NOP)
VM_DEFINE_OP (56, unused_56, NULL, NOP)
{
scm_t_uint16 dst, src;
scm_t_uint32 idx;
UNPACK_12_12 (op, dst, src);
UNPACK_24 (ip[1], idx);
/* CHECK_FREE_VARIABLE (src); */
SP_SET (dst, SCM_PROGRAM_FREE_VARIABLE_REF (SP_REF (src), idx));
NEXT (2);
}
/* free-set! dst:12 src:12 _:8 idx:24
*
* Set free variable IDX from the closure DST to SRC.
*/
VM_DEFINE_OP (56, free_set, "free-set!", OP2 (X8_S12_S12, X8_C24))
{
scm_t_uint16 dst, src;
scm_t_uint32 idx;
UNPACK_12_12 (op, dst, src);
UNPACK_24 (ip[1], idx);
/* CHECK_FREE_VARIABLE (src); */
SCM_PROGRAM_FREE_VARIABLE_SET (SP_REF (dst), idx, SP_REF (src));
NEXT (2);
vm_error_bad_instruction (op);
abort (); /* never reached */
}

5
module/language/cps/compile-bytecode.scm
View file

@ -172,8 +172,6 @@
(emit-word-ref/immediate asm (from-sp dst) (from-sp (slot obj)) idx))
(($ $primcall 'pointer-ref/immediate (annotation . idx) (obj))
(emit-pointer-ref/immediate asm (from-sp dst) (from-sp (slot obj)) idx))
(($ $primcall 'free-ref idx (closure))
(emit-free-ref asm (from-sp dst) (from-sp (slot closure)) idx))
(($ $primcall 'char->integer #f (src))
(emit-char->integer asm (from-sp dst) (from-sp (slot src))))
(($ $primcall 'integer->char #f (src))
@ -302,9 +300,6 @@
(($ $primcall 'pointer-set!/immediate (annotation . idx) (obj val))
(emit-pointer-set!/immediate asm (from-sp (slot obj)) idx
(from-sp (slot val))))
(($ $primcall 'free-set! idx (closure value))
(emit-free-set! asm (from-sp (slot closure)) (from-sp (slot value))
idx))
(($ $primcall 'string-set! #f (string index char))
(emit-string-set! asm (from-sp (slot string)) (from-sp (slot index))
(from-sp (slot char))))

5
module/language/cps/effects-analysis.scm
View file

@ -450,11 +450,6 @@ the LABELS that are clobbered by the effects of LABEL."
((f32-set! obj bv n x) (&write-object (annotation->memory-kind param)))
((f64-set! obj bv n x) (&write-object (annotation->memory-kind param))))
;; Closures.
(define-primitive-effects* param
((free-ref closure) (&read-field &closure param))
((free-set! closure val) (&write-field &closure param)))
;; Modules.
(define-primitive-effects
((current-module) (&read-object &module))

2
module/system/vm/assembler.scm
View file

@ -198,8 +198,6 @@
emit-bind-kwargs
emit-bind-rest
emit-make-closure
emit-free-ref
emit-free-set!
emit-current-module
emit-resolve
emit-define!

2
module/system/vm/disassembler.scm
View file

@ -275,8 +275,6 @@ address of that offset."
(list "~A" (builtin-index->name idx)))
(((or 'static-ref 'static-set!) _ target)
(list "~@Y" (dereference-scm target)))
(((or 'free-ref 'free-set!) _ _ index)
(list "free var ~a" index))
(('resolve-module dst name public)
(list "~a" (if (zero? public) "private" "public")))
(('toplevel-box _ var-offset mod-offset sym-offset bound?)