summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2018-04-10 17:56:08 +0200
committerAndy Wingo <wingo@pobox.com>2018-04-10 17:56:08 +0200
commit1c49c1407bcb9b765a5f58719743fab65790ceca (patch)
tree7f891bb29bed463e7a5f42b2ec4357c1b30866e3
parentb0641783c9b2622b9a6f354baa55d733bce1b48c (diff)
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.
-rw-r--r--libguile/intrinsics.c9
-rw-r--r--libguile/intrinsics.h4
-rw-r--r--libguile/vm-engine.c39
-rw-r--r--module/system/vm/assembler.scm21
4 files changed, 51 insertions, 22 deletions
diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c
index 808708b8d..b974ce177 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 5c0d7909d..b9cc8e4d3 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 74f5ec092..86290fcd9 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 3e36dfe5b..08e0366d0 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)