string.pasm patches the operators mentioned
The other file, 'parrot.pasm', is a miniature Parrot compiler, written
in Parrot.
The patches in the string.diff file are required to make this work.
It's currently -very- limited, due to some issues that I found with
macro processing and some problems in local labels that I found during
development.
Specifically, macros with labels cannot be expanded more than once
without the labels colliding.
The only sample test program it can compile is below (test.pasm):
---cut here---
# comment that will be ignored by parrot.pasm
print 9
# Maybe another comment here, these are ignored.
end
---cut here---
To prove that it is indeed compiling a test file, change '9' to
something like 732, and then:
../assemble.pl parrot.pasm>parrot.pbc
../test_prog parrot.pbc
../test_prog test.pbc
9
~/parrot/>
Now, of course, there are many limitations here.
For one, until macros are fixed (something I'm going to do tonight) I
can't have more than one macro invocation (like, say, sscanf) in a given
file. So, we can't scan for more than one instruction easily.
I also need to restructure the code to do one pass to collect the number
of operators, write that, then write the operator stream out.
--Jeff
<[EMAIL PROTECTED]>
#------------------------------------------------------------------------------
#
# read_file
#
# read_file STRING, FILE_NAME
#
read_file macro R, S, CHUNK_SIZE, TEMP_STRING
pushi
open I31, S, 0
$read_chunk: read TEMP_STRING, I31, CHUNK_SIZE
length I0, TEMP_STRING
eq I0, 0, $done
concat R, TEMP_STRING
eq I0, CHUNK_SIZE, $read_chunk
$done: close I31
popi
endm
#------------------------------------------------------------------------------
#
# sscanf
#
# sscanf STRING, INDEX, VALUE
#
sscanf macro STRING, INDEX, RETURN_VALUE
length I3,STRING
set I2,INDEX
$next_char_2: eq I2,I3,$done_2
ord I1,STRING,I2
lt I1,48,$done_2
gt I1,58,$done_2
sub I1,I1,48
mul RETURN_VALUE,RETURN_VALUE,10
add RETURN_VALUE,RETURN_VALUE,I1
inc I2
branch $next_char_2
$done_2:
endm
#------------------------------------------------------------------------------
write_magic macro FH
write FH,20010401
endm
#------------------------------------------------------------------------------
write_print_ic macro FH,IC
write FH,27
write FH,IC
endm
write_end macro FH
write FH,0
endm
#------------------------------------------------------------------------------
parse_line macro LINE, FILE, TS
eq LINE, "end", $write_end
substr TS, LINE, 0, 5
eq TS, "print", $write_print
branch $done_parsing
$write_end: write_end FILE
branch $done_parsing
$write_print:
sscanf LINE, 6, I28
# ord I28, LINE, 6
# dec I28, 48
write_print_ic FILE, I28
branch $done_parsing
$done_parsing:
endm
split_file macro R, D, TEMP_FILE
open TEMP_FILE,"test.pbc"
write_magic TEMP_FILE
write TEMP_FILE,0
write TEMP_FILE,4
write TEMP_FILE,0
#
# Unfortunate problem
#
write TEMP_FILE,12
set I31,0
length I30,R
$next_char: substr S31,R,I31,1
eq S31,"\n",$end_of_line
concat D,S31
inc I31
eq I31,I30,$end_split
branch $next_char
$end_of_line: parse_line D,TEMP_FILE,S2
set D,""
inc I31
branch $next_char
$end_split: close TEMP_FILE
endm
#------------------------------------------------------------------------------
#
# Main
#
set S0,""
read_file S0,"test.pasm",8,S31
set S1,""
split_file S0,S1,I29
end
#------------------------------------------------------------------------------
diff -ru parrot_orig/core.ops parrot/core.ops
--- parrot_orig/core.ops Tue Nov 6 11:14:25 2001
+++ parrot/core.ops Sat Nov 10 17:55:47 2001
@@ -141,6 +141,26 @@
########################################
+=item B<ord>(i,s|sc)
+
+=item B<ord>(i,s|sc,i|ic)
+
+Set $1 to the appropriate character in string $2.
+Selects character $3 if $3 is present.
+
+=cut
+
+AUTO_OP ord(i,s|sc) {
+ $1 = string_ord($2,0);
+}
+
+AUTO_OP ord(i,s|sc,i|ic) {
+ $1 = string_ord($2,$3);
+}
+
+
+########################################
+
=item B<print>(i|ic)
=item B<print>(n|nc)
@@ -196,12 +216,33 @@
STRING *s;
INTVAL len = $3;
- string_destroy($1);
+ s = $1;
+
tmp = malloc(len + 1);
- read($2, tmp, len);
- s = string_make(interpreter, tmp, len, 0, 0, 0);
- $1 = s;
- free(tmp);
+ len = read($2,tmp,len);
+ tmp[len]=0;
+ if(len==0) {
+ free(tmp); /* Clear up the potential memory leak */
+ if(s && s->bufstart != NULL) {
+ free(s->bufstart); /* Free the old allocated string. */
+ }
+ s->bufstart = NULL;
+ s->buflen = 0;
+ string_compute_strlen(s);
+ s->strlen = 0;
+ }
+ else {
+ if(s && s->bufstart != NULL) {
+ free(s->bufstart);
+ s->bufstart = tmp;
+ s->buflen = len;//strlen(tmp);
+ string_compute_strlen(s);
+ }
+ else {
+ $1 = string_make(interpreter, tmp, strlen(tmp), 0, 0, 0);
+ free(tmp);
+ }
+ }
}
diff -ru parrot_orig/include/parrot/exceptions.h parrot/include/parrot/exceptions.h
--- parrot_orig/include/parrot/exceptions.h Wed Oct 31 17:51:32 2001
+++ parrot/include/parrot/exceptions.h Fri Nov 9 20:06:16 2001
@@ -17,6 +17,7 @@
#define NO_REG_FRAMES 1
#define SUBSTR_OUT_OF_STRING 1
+#define ORD_OUT_OF_STRING 1
#define MALFORMED_UTF8 1
#define MALFORMED_UTF16 1
#define MALFORMED_UTF32 1
diff -ru parrot_orig/include/parrot/string.h parrot/include/parrot/string.h
--- parrot_orig/include/parrot/string.h Wed Oct 31 17:51:32 2001
+++ parrot/include/parrot/string.h Fri Nov 9 20:13:52 2001
@@ -45,6 +45,8 @@
/* Declarations of other functions */
INTVAL
string_length(STRING*);
+INTVAL
+string_ord(STRING* s, INTVAL index);
void
string_grow(STRING* s, INTVAL newsize);
void
diff -ru parrot_orig/string.c parrot/string.c
--- parrot_orig/string.c Wed Oct 31 17:51:31 2001
+++ parrot/string.c Sat Nov 10 18:16:27 2001
@@ -83,6 +83,33 @@
return s->strlen;
}
+/*=for api string string_ord
+ * return the length of the string
+ */
+INTVAL
+string_ord(STRING* s, INTVAL index) {
+ if(s==NULL) {
+ INTERNAL_EXCEPTION(ORD_OUT_OF_STRING,
+ "Cannot get character of empty string");
+ }
+ else {
+ int len = string_length(s);
+ if(index < 0) {
+ INTERNAL_EXCEPTION(ORD_OUT_OF_STRING,
+ "Cannot get character at negative index");
+ }
+ else if(index > (len - 1)) {
+ INTERNAL_EXCEPTION(ORD_OUT_OF_STRING,
+ "Cannot get character past end of string");
+ }
+ else {
+ char *buf = s->bufstart;
+ return buf[index];
+ }
+ }
+ return -1;
+}
+
/*=for api string string_copy
* create a copy of the argument passed in
*/
@@ -175,13 +202,19 @@
*/
STRING*
string_concat(struct Parrot_Interp *interpreter, STRING* a, STRING* b, INTVAL flags) {
- if (a->type != b->type || a->encoding != b->encoding) {
- b = string_transcode(interpreter, b, a->encoding, a->type, NULL);
+ if(a != NULL) {
+ if (a->type != b->type || a->encoding != b->encoding) {
+ b = string_transcode(interpreter, b, a->encoding, a->type, NULL);
+ }
+ string_grow(a, a->strlen + b->strlen);
+ mem_sys_memcopy((void*)((ptrcast_t)a->bufstart + a->bufused), b->bufstart,
+b->bufused);
+ a->strlen = a->strlen + b->strlen;
+ a->bufused = a->bufused + b->bufused;
+ }
+ else {
+ return string_make(interpreter,
+ b->bufstart,b->buflen,b->encoding,flags,b->type);
}
- string_grow(a, a->strlen + b->strlen);
- mem_sys_memcopy((void*)((ptrcast_t)a->bufstart + a->bufused), b->bufstart,
b->bufused);
- a->strlen = a->strlen + b->strlen;
- a->bufused = a->bufused + b->bufused;
return a;
}
diff -ru parrot_orig/t/op/string.t parrot/t/op/string.t
--- parrot_orig/t/op/string.t Tue Oct 16 14:35:04 2001
+++ parrot/t/op/string.t Sat Nov 10 17:52:02 2001
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 24;
+use Parrot::Test tests => 36;
output_is( <<'CODE', <<OUTPUT, "set_s_sc" );
set S4, "JAPH\n"
@@ -127,6 +127,29 @@
length 21
OUTPUT
+output_is( <<'CODE', '', "2-param concat, null onto null" );
+ concat S0,S0
+ end
+CODE
+
+output_is( <<'CODE', <<OUTPUT, '2-param concat, "foo1" onto null' );
+ concat S0,"foo1"
+ print S0
+ print "\n"
+ end
+CODE
+foo1
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, '2-param concat, "foo2" onto null' );
+ set S1,"foo2"
+ concat S0,S1
+ print S0
+ print "\n"
+ end
+CODE
+foo2
+OUTPUT
output_is( <<'CODE', <<OUTPUT, "concat" );
set S1, "fish"
@@ -140,6 +163,7 @@
fishbone
OUTPUT
+
output_is(<<"CODE", <<'OUTPUT', "clears");
@{[ set_str_regs( sub {"BOO $_[0]\\n"} ) ]}
clears
@@ -309,7 +333,64 @@
foo
OUTPUT
+output_is(<<'CODE', 'Cannot get character of empty string','ord on an empty string -
+2-param form');
+ ord I0,S0
+ print I0
+ end
+CODE
+
+output_is(<<'CODE', 'Cannot get character of empty string','3-param ord on an empty
+string');
+ ord I0,S0,I0
+ print I0
+ end
+CODE
+
+output_is(<<'CODE', 'Cannot get character of empty string','3-param ord on an empty
+string - before start');
+ ord I0,S0,-1
+ print I0
+ end
+CODE
+
+output_is(<<'CODE', 'Cannot get character of empty string','3-param ord on an empty
+string - after end');
+ ord I0,S0,1
+ print I0
+ end
+CODE
+
+output_is(<<'CODE', 48, '2-param ord on number');
+ set S0,"0"
+ ord I0,S0
+ print I0
+ end
+CODE
+
+output_is(<<'CODE', 'Cannot get character at negative index', '3-param ord on number,
+before beginning');
+ set S0,"0"
+ ord I0,S0,-1
+ print I0
+ end
+CODE
+
+output_is(<<'CODE', 'Cannot get character past end of string', '3-param ord on
+number, after end');
+ set S0,"0"
+ ord I0,S0,1
+ print I0
+ end
+CODE
+output_is(<<'CODE', ord('a'), '2-param ord on string, index 0');
+ set S0,"absolute"
+ ord I0,S0
+ print I0
+ end
+CODE
+
+output_is(<<'CODE', ord('b'), '3-param ord on string, index 1');
+ set S0,"absolute"
+ ord I0,S0,1
+ print I0
+ end
+CODE
# Set all string registers to values given by &$_[0](reg num)
sub set_str_regs {
