- plugin should not exit jEdit on fatal errors\r
- wordpreview: don't show for string literals and comments\r
- alist -vs- assoc terminology\r
+- NPE in activate()/deactivate()\r
+- write-icon kind of messy; " " should be output by the listener\r
+- f usages. --> don't print all words\r
+- file responder: don't show full path in title\r
+\r
- clean up listener's action popups\r
- jedit ==> jedit-word, jedit takes a file name\r
- introduce ifte* and ?str-head/?str-tail where appropriate\r
- namespace clone drops static var bindings\r
-<kc5tja> The binary register ordering, from 0 to 7, is EAX, ECX, EDX, EBX, ESP, EBP, ESI, EDI.\r
+- when running (inf, .factor-rc not loaded\r
\r
+ bignums:\r
\r
\r
+ listener/plugin:\r
\r
-- NPE in activate()/deactivate()\r
- NPE in ErrorHighlight\r
- some way to not have previous definitions from a source file\r
clutter the namespace\r
\r
+ misc:\r
\r
-- write-icon kind of messy; " " should be output by the listener\r
-- f usages. --> don't print all words\r
-- pipe support\r
-- telnetd: init-history\r
-- str-reverse primitive\r
- some way to run httpd from command line\r
- don't rehash strings on every startup\r
- 'cascading' styles\r
break;
buf.append((char)b);
}
- return buf.toString();
+
+ /* EOF? */
+ if(b == -1 && buf.length() == 0)
+ return null;
+ else
+ return buf.toString();
} //}}}
//{{{ readCount() method
}
else
{
- mw.visitMethodInsn(INVOKESTATIC,
- "factor/FactorJava",
- methodName,
- "(Ljava/lang/Object;)"
- + FactorJava.javaClassToVMClass(type));
+ String signature;
+ if(type.isArray())
+ {
+ signature = "(Ljava/lang/Object;)"
+ + "[Ljava/lang/Object;";
+ }
+ else
+ {
+ signature = "(Ljava/lang/Object;)"
+ + FactorJava.javaClassToVMClass(type);
+ }
+ mw.visitMethodInsn(INVOKESTATIC,"factor/FactorJava",
+ methodName,signature);
+ /* if(type.isArray())
+ {
+ mw.visitTypeInsn(CHECKCAST,
+ type.getName()
+ .replace('.','/'));
+ } */
}
} //}}}
Buffer buffer = view.getBuffer();
int lastUseOffset = 0;
+ boolean trailingNewline = false;
for(int i = 0; i < buffer.getLineCount(); i++)
{
lastUseOffset = buffer.getLineEndOffset(i-1) - 1;
}
else
+ {
+ trailingNewline = true;
break;
+ }
}
String decl = "USE: " + vocab;
if(lastUseOffset != 0)
decl = "\n" + decl;
+ if(trailingNewline)
+ decl = decl + "\n";
buffer.insert(lastUseOffset,decl);
showStatus(view,"inserted-use",decl);
} //}}}
--- /dev/null
+! :folding=indent:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2004 Slava Pestov.
+!
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+!
+! 1. Redistributions of source code must retain the above copyright notice,
+! this list of conditions and the following disclaimer.
+!
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+! this list of conditions and the following disclaimer in the documentation
+! and/or other materials provided with the distribution.
+!
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+IN: compiler
+USE: math
+USE: kernel
+USE: stack
+
+: cell 4 ;
+: literal-table 1024 cell * ;
+
+: init-assembler ( -- )
+ compiled-offset literal-table + set-compiled-offset ;
+
+: intern-literal ( obj -- lit# )
+ address-of
+ literal-top set-compiled-cell
+ literal-top dup cell + set-literal-top ;
+
+: compile-byte ( n -- )
+ compiled-offset set-compiled-byte
+ compiled-offset 1 + set-compiled-offset ;
+
+: compile-cell ( n -- )
+ compiled-offset set-compiled-cell
+ compiled-offset cell + set-compiled-offset ;
+
+: DATASTACK ( -- ptr )
+ #! A pointer to a pointer to the datastack top.
+ 11 getenv ;
+
+: CALLSTACK ( -- ptr )
+ #! A pointer to a pointer to the callstack top.
+ 12 getenv ;
--- /dev/null
+! :folding=indent:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2004 Slava Pestov.
+!
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+!
+! 1. Redistributions of source code must retain the above copyright notice,
+! this list of conditions and the following disclaimer.
+!
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+! this list of conditions and the following disclaimer in the documentation
+! and/or other materials provided with the distribution.
+!
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+IN: compiler
+USE: kernel
+USE: compiler
+USE: math
+USE: stack
+
+: EAX 0 ;
+: ECX 1 ;
+: EDX 2 ;
+: EBX 3 ;
+: ESP 4 ;
+: EBP 5 ;
+: ESI 6 ;
+: EDI 7 ;
+
+: PUSH ( reg -- )
+ HEX: 50 + compile-byte ;
+
+: POP ( reg -- )
+ HEX: 58 + compile-byte ;
+
+: I>R ( imm reg -- )
+ #! MOV <imm> TO <reg>
+ HEX: b8 + compile-byte compile-cell ;
+
+: [I]>R ( imm reg -- )
+ #! MOV INDIRECT <imm> TO <reg>
+ HEX: a1 + compile-byte compile-cell ;
+
+: I>[R] ( imm reg -- )
+ #! MOV <imm> TO INDIRECT <reg>
+ HEX: c7 compile-byte compile-byte compile-cell ;
+
+: [R]>R ( reg reg -- )
+ #! MOV INDIRECT <reg> TO <reg>.
+ HEX: 8b compile-byte swap 3 shift bitor compile-byte ;
+
+: R>[R] ( reg reg -- )
+ #! MOV <reg> TO INDIRECT <reg>.
+ HEX: 89 compile-byte swap 3 shift bitor compile-byte ;
+
+: I+[I] ( imm addr -- )
+ #! ADD <imm> TO ADDRESS <addr>
+ HEX: 81 compile-byte
+ HEX: 05 compile-byte
+ compile-cell
+ compile-cell ;
+
+: LITERAL ( cell -- )
+ #! Push literal on data stack.
+ #! Assume that it is ok to clobber EAX without saving.
+ DATASTACK EAX [I]>R
+ EAX I>[R]
+ 4 DATASTACK I+[I] ;
+
+: [LITERAL] ( cell -- )
+ #! Push literal on data stack by following an indirect
+ #! pointer.
+ ECX PUSH
+ ( cell -- ) ECX I>R
+ ECX ECX [R]>R
+ DATASTACK EAX [I]>R
+ ECX EAX R>[R]
+ 4 DATASTACK I+[I]
+ ECX POP ;
+
+: (JMP) ( xt opcode -- )
+ #! JMP, CALL insn is 5 bytes long
+ #! addr is relative to *after* insn
+ compile-byte compiled-offset 4 + - compile-cell ;
+
+: JMP ( -- )
+ HEX: e9 (JMP) ;
+
+: CALL ( -- )
+ HEX: e8 (JMP) ;
+
+: RET ( -- )
+ HEX: c3 compile-byte ;
--- /dev/null
+! :folding=indent:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2004 Slava Pestov.
+!
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+!
+! 1. Redistributions of source code must retain the above copyright notice,
+! this list of conditions and the following disclaimer.
+!
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+! this list of conditions and the following disclaimer in the documentation
+! and/or other materials provided with the distribution.
+!
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+IN: compiler
+USE: math
+USE: stack
+USE: lists
+USE: combinators
+USE: words
+USE: namespaces
+USE: unparser
+USE: errors
+USE: strings
+USE: logic
+USE: kernel
+USE: vectors
+
+: compile-word ( word -- )
+ #! Compile a JMP at the end (tail call optimization)
+ word-xt "compile-last" get [ JMP ] [ CALL ] ifte ;
+
+: compile-literal ( obj -- )
+ dup fixnum? [
+ address-of LITERAL
+ ] [
+ intern-literal [LITERAL]
+ ] ifte ;
+
+: commit-literals ( -- )
+ "compile-datastack" get dup [ compile-literal ] vector-each
+ 0 swap set-vector-length ;
+
+: postpone ( obj -- )
+ "compile-datastack" get vector-push ;
+
+: compile-atom ( obj -- )
+ [
+ [ word? ] [ commit-literals compile-word ]
+ [ drop t ] [ postpone ]
+ ] cond ;
+
+: compile-loop ( quot -- )
+ dup [
+ unswons
+ over not "compile-last" set
+ compile-atom
+ compile-loop
+ ] [
+ commit-literals drop RET
+ ] ifte ;
+
+: compile-quot ( quot -- xt )
+ [
+ "compile-last" off
+ 10 <vector> "compile-datastack" set
+ compiled-offset swap compile-loop
+ ] with-scope ;
+
+: compile ( word -- )
+ intern dup word-parameter compile-quot swap set-word-xt ;
+
+: call-xt ( xt -- )
+ #! For testing.
+ 0 f f <word> [ set-word-xt ] keep execute ;
USE: words
IN: compiler
-DEFER: compile-byte
-DEFER: compile-cell
-DEFER: compile-offset
+DEFER: set-compiled-byte
+DEFER: set-compiled-cell
+DEFER: compiled-offset
+DEFER: set-compiled-offset
+DEFER: literal-top
+DEFER: set-literal-top
IN: kernel
DEFER: getenv
DEFER: os-env
DEFER: type-of
DEFER: size-of
+DEFER: address-of
DEFER: dump
IN: strings
str-hashcode
index-of*
substring
+ str-reverse
sbuf?
<sbuf>
sbuf-length
dump
cwd
cd
- compile-byte
- compile-cell
- compile-offset
+ set-compiled-byte
+ set-compiled-cell
+ compiled-offset
+ set-compiled-offset
+ literal-top
+ set-literal-top
+ address-of
] [
swap succ tuck primitive,
] each drop ;
: sbuf-reverse ( sbuf -- )
#! Destructively reverse a string buffer.
[ ] "java.lang.StringBuffer" "reverse" jinvoke drop ;
+
+DEFER: str>sbuf
+: str-reverse ( str -- str )
+ str>sbuf dup sbuf-reverse sbuf>str ;
#! java.io.OutputStream out. The streams are wrapped in
#! buffered streams.
<stream> [
- <bout> "out" set
- <bin> "in" set
+ "out" set
+ "in" set
( -- string )
[ <byte-stream>/freadln ] "freadln" set
( count -- string )
<char-stream> ;
: <filebr> ( path -- stream )
- [ "java.lang.String" ] "java.io.FileInputStream" jnew
+ [ "java.lang.String" ] "java.io.FileInputStream" jnew <bin>
f
<byte-stream> ;
: <filebw> ( path -- stream )
- [ "java.lang.String" ] "java.io.FileOutputStream" jnew
+ [ "java.lang.String" ] "java.io.FileOutputStream" jnew <bout>
f swap
<byte-stream> ;
: <socket-stream> ( socket -- stream )
#! Wraps a socket inside a byte-stream.
dup
- [ [ ] "java.net.Socket" "getInputStream" jinvoke ]
- [ [ ] "java.net.Socket" "getOutputStream" jinvoke ]
+ [ [ ] "java.net.Socket" "getInputStream" jinvoke <bin> ]
+ [ [ ] "java.net.Socket" "getOutputStream" jinvoke <bout> ]
cleave
<byte-stream> [
dup >str "client" set "socket" set
"/library/telnetd.factor"
"/library/inferior.factor"
"/library/platform/native/profiler.factor"
- "/library/platform/native/compiler.factor"
"/library/image.factor"
"/library/cross-compiler.factor"
"/library/jedit/jedit-remote.factor"
"/library/jedit/jedit.factor"
+ "/library/compiler/assembler.factor"
+ "/library/compiler/assembly-x86.factor"
+ "/library/compiler/compiler.factor"
+
"/library/platform/native/primitives.factor"
"/library/init.factor"
+++ /dev/null
-IN: compiler
-USE: math
-USE: stack
-USE: lists
-USE: combinators
-USE: words
-USE: namespaces
-USE: unparser
-USE: errors
-USE: strings
-USE: logic
-USE: kernel
-
-: DATASTACK
- #! A pointer to a pointer to the datastack top.
- 11 getenv ;
-
-: EAX 0 ;
-: ECX 1 ;
-: EDX 2 ;
-: EBX 3 ;
-: ESP 4 ;
-: EBP 5 ;
-: ESI 6 ;
-: EDI 7 ;
-
-: I>R ( imm reg -- )
- #! MOV <imm> TO <reg>
- HEX: a1 + compile-byte compile-cell ;
-
-: I>[R] ( imm reg -- )
- #! MOV <imm> TO ADDRESS <reg>
- HEX: c7 compile-byte compile-byte compile-cell ;
-
-: I+[I] ( imm addr -- )
- #! ADD <imm> TO ADDRESS <addr>
- HEX: 81 compile-byte
- HEX: 05 compile-byte
- compile-cell
- compile-cell ;
-
-: LITERAL ( cell -- )
- #! Push literal on data stack.
- DATASTACK EAX I>R EAX I>[R] 4 DATASTACK I+[I] ;
-
-: (JMP) ( xt opcode -- )
- #! JMP, CALL insn is 5 bytes long
- #! addr is relative to *after* insn
- compile-byte compile-offset 4 + - compile-cell ;
-
-: JMP HEX: e9 (JMP) ;
-: CALL HEX: e8 (JMP) ;
-: RET HEX: c3 compile-byte ;
-
-: compile-word ( word -- )
- #! Compile a JMP at the end (tail call optimization)
- word-xt "compile-last" get [ JMP ] [ CALL ] ifte ;
-
-: compile-fixnum ( n -- )
- 3 shift 7 bitnot bitand LITERAL ;
-
-: compile-atom ( obj -- )
- [
- [ fixnum? ] [ compile-fixnum ]
- [ word? ] [ compile-word ]
- [ drop t ] [ "Cannot compile " swap unparse cat2 throw ]
- ] cond ;
-
-: compile-loop ( quot -- )
- dup [
- unswons
- over not "compile-last" set
- compile-atom
- compile-loop
- ] [
- drop RET
- ] ifte ;
-
-: compile-quot ( quot -- xt )
- [
- "compile-last" off
- compile-offset swap compile-loop
- ] with-scope ;
-
-: compile ( word -- )
- intern dup word-parameter compile-quot swap set-word-xt ;
-
-: call-xt ( xt -- )
- #! For testing.
- 0 f f <word> [ set-word-xt ] keep execute ;
: bad-primitive-error ( obj -- )
"Bad primitive number: " write . ;
+: c-string-error ( obj -- )
+ "Cannot convert to C string: " write . ;
+
: kernel-error. ( obj n -- str )
{
expired-port-error
profiling-disabled-error
negative-array-size-error
bad-primitive-error
+ c-string-error
} vector-nth execute ;
: kernel-error? ( obj -- ? )
IN: init
USE: combinators
+USE: compiler
USE: errors
USE: kernel
USE: namespaces
USE: vectors
USE: words
USE: unparser
+USE: compiler
[
[ execute | " word -- " ]
[ dump | " obj -- " ]
[ cwd | " -- dir " ]
[ cd | " dir -- " ]
+ [ set-compiled-byte | " n ptr -- " ]
+ [ set-compiled-cell | " n ptr -- " ]
+ [ compiled-offset | " -- ptr " ]
+ [ set-compiled-offset | " ptr -- " ]
+ [ literal-top | " -- ptr " ]
+ [ set-literal-top | " ptr -- " ]
] [
unswons "stack-effect" swap set-word-property
] each
global [ "last-word" set ] bind ;
: define-compound ( word def -- )
- #! Define a compound word at runtime.
over set-word-parameter
1 swap set-word-primitive ;
: split-n ( n str -- list )
#! Split a string into n-character chunks.
[, 0 -rot (split-n) ,] ;
-
-: str-reverse ( str -- str )
- str>sbuf dup sbuf-reverse sbuf>str ;
dupd str-tail? dup [ nip t ] [ drop f ] ifte ;
: split1 ( string split -- before after )
- #! The car of the pair is the string up to the first
- #! occurrence of split; the cdr is the remainder of
- #! the string.
2dup index-of dup -1 = [
2drop f
] [
return s48_bignum_to_long(untag_bignum(x));
default:
type_error(INTEGER_TYPE,x);
+ return 0;
}
}
void init_compiler(void)
{
init_zone(&compiling,COMPILE_ZONE_SIZE);
+ literal_top = compiling.base;
}
-void primitive_compile_byte(void)
+void check_compiled_offset(CELL offset)
{
- bput(compiling.here,to_fixnum(dpop()));
- compiling.here++;
+ if(offset < compiling.base || offset >= compiling.limit)
+ range_error(F,offset,compiling.limit);
}
-void primitive_compile_cell(void)
+void primitive_set_compiled_byte(void)
{
- put(compiling.here,to_cell(dpop()));
- compiling.here += sizeof(CELL);
+ CELL offset = to_cell(dpop());
+ BYTE b = to_fixnum(dpop());
+ check_compiled_offset(offset);
+ bput(offset,b);
}
-void primitive_compile_offset(void)
+void primitive_set_compiled_cell(void)
+{
+ CELL offset = to_cell(dpop());
+ CELL c = to_fixnum(dpop());
+ check_compiled_offset(offset);
+ put(offset,c);
+}
+
+void primitive_compiled_offset(void)
{
dpush(tag_integer(compiling.here));
}
+
+void primitive_set_compiled_offset(void)
+{
+ CELL offset = to_cell(dpop());
+ check_compiled_offset(offset);
+ compiling.here = offset;
+}
+
+void primitive_literal_top(void)
+{
+ dpush(tag_integer(literal_top));
+}
+
+void primitive_set_literal_top(void)
+{
+ CELL offset = to_cell(dpop());
+ check_compiled_offset(offset);
+ literal_top = offset;
+}
+
+void collect_literals(void)
+{
+ CELL i = compiling.base;
+ while(i < literal_top)
+ {
+ copy_object((CELL*)i);
+ i += CELLS;
+ }
+}
ZONE compiling;
+CELL literal_top;
void init_compiler(void);
-void primitive_compile_byte(void);
-void primitive_compile_cell(void);
-void primitive_compile_offset(void);
+void primitive_set_compiled_byte(void);
+void primitive_set_compiled_cell(void);
+void primitive_compiled_offset(void);
+void primitive_set_compiled_offset(void);
+void primitive_literal_top(void);
+void primitive_set_literal_top(void);
+void collect_literals(void);
fprintf(stderr,"Got type #%ld\n",type_of(
untag_cons(tagged)->cdr));
}
+ fflush(stderr);
exit(1);
}
throw_error(c);
#define ERROR_PROFILING_DISABLED (11<<3)
#define ERROR_NEGATIVE_ARRAY_SIZE (12<<3)
#define ERROR_BAD_PRIMITIVE (13<<3)
+#define ERROR_C_STRING (14<<3)
void fatal_error(char* msg, CELL tagged);
void critical_error(char* msg, CELL tagged);
scan = active.here = active.base;
collect_roots();
collect_io_tasks();
+ /* collect literal objects referenced from compiled code */
+ collect_literals();
while(scan < active.here)
{
gc_debug("scan loop",scan);
HEADER h;
CELL size;
- fprintf(stderr,"Loading %s...",filename);
+ printf("Loading %s...",filename);
file = fopen(filename,"rb");
if(file == NULL)
active.here = active.base + h.size;
fclose(file);
- fprintf(stderr," relocating...");
+ printf(" relocating...");
fflush(stdout);
clear_environment();
relocate(h.relocation_base);
- fprintf(stderr," done\n");
+ printf(" done\n");
+ fflush(stdout);
}
bool save_image(char* filename)
}
#endif
}
+
+void primitive_address_of(void)
+{
+ dpush(tag_object(s48_ulong_to_bignum(dpop())));
+}
void primitive_room(void);
void primitive_allot_profiling(void);
+void primitive_address_of(void);
primitive_string_hashcode,
primitive_index_of,
primitive_substring,
+ primitive_string_reverse,
primitive_sbufp,
primitive_sbuf,
primitive_sbuf_length,
primitive_dump,
primitive_cwd,
primitive_cd,
- primitive_compile_byte,
- primitive_compile_cell,
- primitive_compile_offset
+ primitive_set_compiled_byte,
+ primitive_set_compiled_cell,
+ primitive_compiled_offset,
+ primitive_set_compiled_offset,
+ primitive_literal_top,
+ primitive_set_literal_top,
+ primitive_address_of
};
CELL primitive_to_xt(CELL primitive)
extern XT primitives[];
-#define PRIMITIVE_COUNT 155
+#define PRIMITIVE_COUNT 160
CELL primitive_to_xt(CELL primitive);
}
}
-STRING* sbuf_to_string(SBUF* sbuf)
-{
- STRING* string = allot_string(sbuf->top);
- memcpy(string + 1,sbuf->string + 1,sbuf->top * CHARS);
- hash_string(string);
- return string;
-}
-
void primitive_sbuf_to_string(void)
{
- drepl(tag_object(sbuf_to_string(untag_sbuf(dpeek()))));
+ SBUF* sbuf = untag_sbuf(dpeek());
+ STRING* s = string_clone(sbuf->string,sbuf->top);
+ hash_string(s);
+ drepl(tag_object(s));
}
void primitive_sbuf_reverse(void)
{
SBUF* sbuf = untag_sbuf(dpop());
- int i, j;
- CHAR ch1, ch2;
- for(i = 0; i < sbuf->top / 2; i++)
- {
- j = sbuf->top - i - 1;
- ch1 = string_nth(sbuf->string,i);
- ch2 = string_nth(sbuf->string,j);
- set_string_nth(sbuf->string,j,ch1);
- set_string_nth(sbuf->string,i,ch2);
- }
+ string_reverse(sbuf->string,sbuf->top);
}
void primitive_sbuf_clone(void)
void primitive_set_sbuf_nth(void);
void sbuf_append_string(SBUF* sbuf, STRING* string);
void primitive_sbuf_append(void);
-STRING* sbuf_to_string(SBUF* sbuf);
void primitive_sbuf_to_string(void);
void primitive_sbuf_reverse(void);
void primitive_sbuf_clone(void);
BYTE* c_str = (BYTE*)(_c_str + 1);
for(i = 0; i < s->capacity; i++)
+ {
+ CHAR ch = string_nth(s,i);
+ if(ch == '\0' || ch > 255)
+ general_error(ERROR_C_STRING,tag_object(s));
c_str[i] = string_nth(s,i);
+ }
c_str[s->capacity] = '\0';
CELL start = to_fixnum(dpop());
dpush(tag_object(substring(start,end,string)));
}
+
+/* DESTRUCTIVE - don't use with user-visible strings */
+void string_reverse(STRING* s, int len)
+{
+ int i, j;
+ CHAR ch1, ch2;
+ for(i = 0; i < len / 2; i++)
+ {
+ j = len - i - 1;
+ ch1 = string_nth(s,i);
+ ch2 = string_nth(s,j);
+ set_string_nth(s,j,ch1);
+ set_string_nth(s,i,ch2);
+ }
+}
+
+/* Doesn't rehash the string! */
+STRING* string_clone(STRING* s, int len)
+{
+ STRING* copy = allot_string(len);
+ memcpy(copy + 1,s + 1,len * CHARS);
+ return copy;
+}
+
+void primitive_string_reverse(void)
+{
+ STRING* s = untag_string(dpeek());
+ s = string_clone(s,s->capacity);
+ string_reverse(s,s->capacity);
+ hash_string(s);
+ drepl(tag_object(s));
+}
+
+STRING* fixup_untagged_string(STRING* str)
+{
+ return (STRING*)((CELL)str + (active.base - relocation_base));
+}
+
+STRING* copy_untagged_string(STRING* str)
+{
+ return copy_untagged_object(str,SSIZE(str));
+}
void primitive_string_hashcode(void);
void primitive_index_of(void);
void primitive_substring(void);
-
-INLINE STRING* fixup_untagged_string(STRING* str)
-{
- return (STRING*)((CELL)str + (active.base - relocation_base));
-}
-
-INLINE STRING* copy_untagged_string(STRING* str)
-{
- return copy_untagged_object(str,SSIZE(str));
-}
+void string_reverse(STRING* s, int len);
+STRING* string_clone(STRING* s, int len);
+void primitive_string_reverse(void);
+STRING* fixup_untagged_string(STRING* str);
+STRING* copy_untagged_string(STRING* str);
projects / factor.git / commitdiff