wingo pushed a commit to branch master in repository guile. commit 1c49c1407bcb9b765a5f58719743fab65790ceca Author: Andy Wingo <wi...@pobox.com> Date: Tue Apr 10 17:56:08 2018 +0200
string->number, etc intrinsics * libguile/intrinsics.c (string_to_number): New helper. (scm_bootstrap_intrinsics): Init new intrinsics. * libguile/intrinsics.h (string->number, string->symbol) (symbol->keyword): Add new intrinsics. * libguile/vm-engine.c (call-scm<-scm): New intrinsic dispatcher. (string->number, string->symbol, symbol->keyword): Disable these instructions. * module/system/vm/assembler.scm (encode-X8_S12_S12-C32<-/shuffle): (define-scm<-scm-intrinsic): Enable scm<-scm intrinsics. (string->number, string->symbol, symbol->keyword): New intrinsic assemblers. --- libguile/intrinsics.c | 9 +++++++++ libguile/intrinsics.h | 4 ++++ libguile/vm-engine.c | 39 ++++++++++++++++++++------------------- module/system/vm/assembler.scm | 21 ++++++++++++++++++--- 4 files changed, 51 insertions(+), 22 deletions(-) diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c index 808708b..b974ce1 100644 --- a/libguile/intrinsics.c +++ b/libguile/intrinsics.c @@ -65,6 +65,12 @@ string_set_x (SCM str, scm_t_uint64 idx, scm_t_uint64 ch) scm_i_string_stop_writing (); } +static SCM +string_to_number (SCM str) +{ + return scm_string_to_number (str, SCM_UNDEFINED /* radix = 10 */); +} + void scm_bootstrap_intrinsics (void) { @@ -81,6 +87,9 @@ scm_bootstrap_intrinsics (void) scm_vm_intrinsics.logior = scm_logior; scm_vm_intrinsics.logxor = scm_logxor; scm_vm_intrinsics.string_set_x = string_set_x; + scm_vm_intrinsics.string_to_number = string_to_number; + scm_vm_intrinsics.string_to_symbol = scm_string_to_symbol; + scm_vm_intrinsics.symbol_to_keyword = scm_symbol_to_keyword; scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, "scm_init_intrinsics", diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h index 5c0d790..b9cc8e4 100644 --- a/libguile/intrinsics.h +++ b/libguile/intrinsics.h @@ -26,6 +26,7 @@ typedef SCM (*scm_t_scm_from_scm_scm_intrinsic) (SCM, SCM); typedef SCM (*scm_t_scm_from_scm_uimm_intrinsic) (SCM, scm_t_uint8); typedef void (*scm_t_scm_u64_u64_intrinsic) (SCM, scm_t_uint64, scm_t_uint64); +typedef SCM (*scm_t_scm_from_scm_intrinsic) (SCM); #define SCM_FOR_ALL_VM_INTRINSICS(M) \ M(scm_from_scm_scm, add, "add", ADD) \ @@ -41,6 +42,9 @@ typedef void (*scm_t_scm_u64_u64_intrinsic) (SCM, scm_t_uint64, scm_t_uint64); M(scm_from_scm_scm, logior, "logior", LOGIOR) \ M(scm_from_scm_scm, logxor, "logxor", LOGXOR) \ M(scm_u64_u64, string_set_x, "string-set!", STRING_SET_X) \ + M(scm_from_scm, string_to_number, "string->number", STRING_TO_NUMBER) \ + M(scm_from_scm, string_to_symbol, "string->symbol", STRING_TO_SYMBOL) \ + M(scm_from_scm, symbol_to_keyword, "symbol->keyword", SYMBOL_TO_KEYWORD) \ /* Add new intrinsics here; also update scm_bootstrap_intrinsics. */ enum scm_vm_intrinsic diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 74f5ec0..86290fc 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -1546,7 +1546,23 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, NEXT (2); } - VM_DEFINE_OP (54, unused_54, NULL, NOP) + VM_DEFINE_OP (54, call_scm_from_scm, "call-scm<-scm", OP2 (X8_S12_S12, C32) | OP_DST) + { + scm_t_uint8 dst, src; + SCM res; + scm_t_scm_from_scm_intrinsic intrinsic; + + UNPACK_12_12 (op, dst, src); + intrinsic = intrinsics[ip[1]]; + + SYNC_IP (); + res = intrinsic (SP_REF (src)); + CACHE_SP (); + SP_SET (dst, res); + + NEXT (2); + } + VM_DEFINE_OP (55, unused_55, NULL, NOP) VM_DEFINE_OP (56, unused_56, NULL, NOP) { @@ -2122,14 +2138,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, abort (); /* never reached */ } - /* string-set! instruction is currently number 192. Probably need to - reorder before releasing. */ - - /* string->number dst:12 src:12 - * - * Parse a string in SRC to a number, and store in DST. - */ - VM_DEFINE_OP (78, string_to_number, "string->number", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (78, unused_78, NULL, NOP) { scm_t_uint16 dst, src; @@ -2141,11 +2150,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, NEXT (1); } - /* string->symbol dst:12 src:12 - * - * Parse a string in SRC to a symbol, and store in DST. - */ - VM_DEFINE_OP (79, string_to_symbol, "string->symbol", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (79, unused_79, NULL, NOP) { scm_t_uint16 dst, src; @@ -2155,11 +2160,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, NEXT (1); } - /* symbol->keyword dst:12 src:12 - * - * Make a keyword from the symbol in SRC, and store it in DST. - */ - VM_DEFINE_OP (80, symbol_to_keyword, "symbol->keyword", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (80, unused_80, NULL, NOP) { scm_t_uint16 dst, src; UNPACK_12_12 (op, dst, src); diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 3e36dfe..08e0366 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -196,6 +196,9 @@ emit-logior emit-logxor emit-string-set! + emit-string->number + emit-string->symbol + emit-symbol->keyword emit-call emit-call-label @@ -231,9 +234,6 @@ emit-current-thread emit-fluid-ref emit-fluid-set! - emit-string->number - emit-string->symbol - emit-symbol->keyword emit-lsh emit-rsh emit-lsh/immediate @@ -900,6 +900,14 @@ later by the linker." (emit-push asm (+ c 2)) (encode-X8_S8_S8_S8-C32 asm 2 1 0 c32 opcode) (emit-drop asm 3)))) +(define (encode-X8_S12_S12-C32<-/shuffle asm dst src c32 opcode) + (cond + ((< (logior dst src) (ash 1 12)) + (encode-X8_S12_S12-C32 asm dst src c32 opcode)) + (else + (emit-push asm src) + (encode-X8_S12_S12-C32 asm 0 0 c32 opcode) + (emit-pop asm dst)))) (eval-when (expand) (define (id-append ctx a b) @@ -921,6 +929,7 @@ later by the linker." (('<- 'X8_S8_S8_S8 'C32) #'encode-X8_S8_S8_S8-C32<-/shuffle) (('<- 'X8_S8_S8_C8 'C32) #'encode-X8_S8_S8_C8-C32<-/shuffle) (('! 'X8_S8_S8_C8 'C32) #'encode-X8_S8_S8_C8-C32!/shuffle) + (('<- 'X8_S12_S12 'C32) #'encode-X8_S12_S12-C32<-/shuffle) (('! 'X8_S8_C8_S8) #'encode-X8_S8_C8_S8!/shuffle) (('<- 'X8_S8_C8_S8) #'encode-X8_S8_C8_S8<-/shuffle) (else (encoder-name operands)))) @@ -1282,6 +1291,9 @@ returned instead." (define-syntax-rule (define-scm-u64-u64-intrinsic name) (define-macro-assembler (name asm a b c) (emit-call-scm-u64-u64 asm a b c (intrinsic-name->index 'name)))) +(define-syntax-rule (define-scm<-scm-intrinsic name) + (define-macro-assembler (name asm dst src) + (emit-call-scm<-scm asm dst src (intrinsic-name->index 'name)))) (define-scm<-scm-scm-intrinsic add) (define-scm<-scm-uimm-intrinsic add/immediate) @@ -1296,6 +1308,9 @@ returned instead." (define-scm<-scm-scm-intrinsic logior) (define-scm<-scm-scm-intrinsic logxor) (define-scm-u64-u64-intrinsic string-set!) +(define-scm<-scm-intrinsic string->number) +(define-scm<-scm-intrinsic string->symbol) +(define-scm<-scm-intrinsic symbol->keyword) (define-macro-assembler (begin-program asm label properties) (emit-label asm label)