moved pack-raw-string into core.e

Force-Push: yes
Change-Id: I0940c0c21580e810716a5f61b95fd520c464ab9e

3 files changed, 52 insertions, 5 deletions

diff --git a/core.e b/core.e
index 62e2301..e49c2f9 100644
--- a/core.e
+++ b/core.e
@@ -1197,6 +1197,20 @@ here !
   ~ (output point, source, destination, length)
   memcopy ;
 
+~   This also works on C-style strings, relying on the null terminator, but
+~ the packed data does not include it.
+~
+~ (output point, string pointer -- output point)
+: pack-raw-string
+  dup stringlen dup
+  ~ (output point, source, length, length)
+  4 roll dup 4 unroll
+
+  ~ (source, destination, length, length, output point)
+  + 4 unroll
+  ~ (output point, source, destination, length)
+  memcopy ;
+
 ~ (output point, alignment byte count -- output point)
 : packalign
   { 2dup /% drop { drop exit } unless
diff --git a/labels.e b/labels.e
index 6175128..0d2b60d 100644
--- a/labels.e
+++ b/labels.e
@@ -50,11 +50,6 @@
 ~   Most of the time, the shorthand words L@' and L!' will be all you need to
 ~ use from your own code.
 
-~ TODO this should go somewhere else :)
-~ (current output point, string pointer --)
-: pack-raw-string
-  { unpack8 dup } { 3roll swap pack8 swap } while drop drop ;
-
 ~   The labels data structure is a linked list of dictionary entries, with
 ~ the same header format as the main Evocation dictionary, but instead of
 ~ being executable, each holds two words of data: status bits, and a value,
diff --git a/quine.asm b/quine.asm
index b47eb5a..3002cab 100644
--- a/quine.asm
+++ b/quine.asm
@@ -3035,6 +3035,26 @@ cold_start:
   dq litstring, "exit", early_find, entry_to_execution_token, early_comma
   dq early_here, fetch, lit, 8, packalign, early_here_store
 
+  ; This was "pack_raw_string".
+  dq litstring, "pack-raw-string", early_create, early_docol_codeword
+  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "stringlen", early_find, entry_to_execution_token, early_comma
+  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "lit", early_find, entry_to_execution_token, early_comma
+  dq lit, 4, early_comma
+  dq litstring, "roll", early_find, entry_to_execution_token, early_comma
+  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "lit", early_find, entry_to_execution_token, early_comma
+  dq lit, 4, early_comma
+  dq litstring, "unroll", early_find, entry_to_execution_token, early_comma
+  dq litstring, "+", early_find, entry_to_execution_token, early_comma
+  dq litstring, "lit", early_find, entry_to_execution_token, early_comma
+  dq lit, 4, early_comma
+  dq litstring, "unroll", early_find, entry_to_execution_token, early_comma
+  dq litstring, "memcopy", early_find, entry_to_execution_token, early_comma
+  dq litstring, "exit", early_find, entry_to_execution_token, early_comma
+  dq early_here, fetch, lit, 8, packalign, early_here_store
+
   dq litstring, "packalign", early_create, early_docol_codeword
   dq litstring, "2dup", early_find, entry_to_execution_token, early_comma
   dq litstring, "/%", early_find, entry_to_execution_token, early_comma
@@ -9539,6 +9559,24 @@ defword packstring, 0
   dq memcopy
   dq exit
 
+;   This also works on C-style strings, relying on the null terminator, but
+; the packed data does not include it.
+;
+; Stack in:
+;   base address, string pointer
+; Stack out:
+;   new base address
+defword pack_raw_string, 0
+  dq docol
+  dq dup, stringlen, dup
+  ; base/destination, source, length, length
+  dq lit, 4, roll, dup, lit, 4, unroll
+  ; source, destination, length, length, base/destination
+  dq add, lit, 4, unroll
+  ; new base, source, destination, length
+  dq memcopy
+  dq exit
+
 ; Stack in:
 ;   base address
 ;   byte size