new and improved coming soon
luser- -droog
how many times I've started this project over from scratch.
So I think I'm getting pretty good at it.
I'm really thrilled about this new design. The code is sooo
much smaller. I think factoring the typechecks out of the
operators has contributed the most. But then of course,
I went overboard and decided to write as many operators
as possible as one-liners. So as a sampling. here is the
complete set of boolean operator functions.
/* boolean */
void NNeq(state *st, object x, object y)
{ push(consbool(objcmp(st,x,y) == 0)); }
void NNne(state *st, object x, object y)
{ push(consbool(objcmp(st,x,y) != 0)); }
void NNge(state *st, object x, object y)
{ push(consbool(objcmp(st,x,y) >= 0)); }
void NNgt(state *st, object x, object y)
{ push(consbool(objcmp(st,x,y) > 0)); }
void NNle(state *st, object x, object y)
{ push(consbool(objcmp(st,x,y) <= 0)); }
void NNlt(state *st, object x, object y)
{ push(consbool(objcmp(st,x,y) < 0)); }
void BBand(state *st, object x, object y) { push(consbool(x.u.b &
y.u.b)); }
void IIand(state *st, object x, object y) { push(consbool(x.u.i &
y.u.i)); }
void Bnot(state *st, object x, object y) { push(consbool(! x.u.b)); }
void Inot(state *st, object x, object y) { push(consbool(! x.u.i)); }
void BBor(state *st, object x, object y) { push(consbool(x.u.b |
y.u.b)); }
void IIor(state *st, object x, object y) { push(consbool(x.u.i |
y.u.i)); }
void BBxor(state *st, object x, object y) { push(consbool(x.u.b ^
y.u.b)); }
void IIxor(state *st, object x, object y) { push(consbool(x.u.i ^
y.u.i)); }
void IIbitshift(state *st, object x, object y) {
push(consint( y.u.i > 0 ? x.u.i << y.u.i : x.u.i >> -y.u.i ));
}
Usenet's gonna chop all that up isn't it?
Here it is reformatted with minimal breaks.
/* boolean */
void NNeq(state *st, object x, object y)
{ push(consbool(objcmp(st,x,y) == 0)); }
void NNne(state *st, object x, object y)
{ push(consbool(objcmp(st,x,y) != 0)); }
void NNge(state *st, object x, object y)
{ push(consbool(objcmp(st,x,y) >= 0)); }
void NNgt(state *st, object x, object y)
{ push(consbool(objcmp(st,x,y) > 0)); }
void NNle(state *st, object x, object y)
{ push(consbool(objcmp(st,x,y) <= 0)); }
void NNlt(state *st, object x, object y)
{ push(consbool(objcmp(st,x,y) < 0)); }
void BBand(state *st, object x, object y)
{ push(consbool(x.u.b & y.u.b)); }
void IIand(state *st, object x, object y)
{ push(consbool(x.u.i & y.u.i)); }
void Bnot(state *st, object x, object y)
{ push(consbool(! x.u.b)); }
void Inot(state *st, object x, object y)
{ push(consbool(! x.u.i)); }
void BBor(state *st, object x, object y)
{ push(consbool(x.u.b | y.u.b)); }
void IIor(state *st, object x, object y)
{ push(consbool(x.u.i | y.u.i)); }
void BBxor(state *st, object x, object y)
{ push(consbool(x.u.b ^ y.u.b)); }
void IIxor(state *st, object x, object y)
{ push(consbool(x.u.i ^ y.u.i)); }
void IIbitshift(state *st, object x, object y)
{ push(consint( y.u.i > 0 ? x.u.i << y.u.i : x.u.i >> -
y.u.i )); }
I think there's nothing left to take away!
luser- -droog
So I've tried to sup' up the central loop by "pipelining".
/* perform one iteration of the interpreter loop */
/* Calls the operator functions token and load
via shortcuts in op.c:struct opcut opcuts. */
/* Optimized so that if the top of exec stack
holds a file (or string), and that file begins
with a name and that name is defined as an array
and that array begins with an operator,
that operator is found and executed in one cycle;
leaving the file, and rest of array on the exec stack.
So calling bound procedures should be quite fast.
*/
int eval (state *st) {
object q;
/* something to do? */
if (tes-es < 1) {
error(execstackunderflow);
st->quit = true;
return 0;
}
/* room to work? */
if (tes-es + 3 > ESSIZE) error(execstackoverflow);
if (tos-os + 3 > OSSIZE) error(stackoverflow);
q = pope();
printf("q = "); o_dump(st,q);
if (!q.flags.lit) switch (q.tag) {
case filetype: /* token exch pushe */
case stringtype:
push(q);
//opexec(st, consoper(st, "token", NULL,0,0).u.u);
opexec(st, op_cuts.token);
if (pop().u.b) { /* bool */
q = pop(); /* token */
pushe(pop()); /* post */
if (q.tag == arraytype) {
push(q);
goto skip_push;
}
} else {
goto skip_push;
}
}
if (!q.flags.lit && q.tag == nametype) {
/* load */
push(q);
//opexec(st, consoper(st, "load", NULL,0,0).u.u);
opexec(st, op_cuts.load);
q = pop();
}
if (!q.flags.lit && q.tag == arraytype) {
switch(q.u.c.n) {
default /* > 1 */: /* getinterval exec */
//push(q);
//push(consint(1));
//push(consint(q.u.c.n-1));
//opexec(st, consoper(st, "getinterval", NULL,
0,0).u.u);
//pushe(pop());
pushe(q);
tes[-1].u.c.off += 1;
tes[-1].u.c.n -= 1;
case 1: /* get */
//push(q);
//push(consint(0));
//stack_dump(st);
//opexec(st, consoper(st, "get", NULL,0,0).u.u);
//q = pop();
q = a_get(st, q, 0);
break;
case 0: goto skip_push; /* drop it */
}
}
if (!q.flags.lit && q.tag == operatortype) {
opexec(st, q.u.u);
goto skip_push;
}
if (q.flags.lit) push(q);
else pushe(q);
skip_push:
if (st->quit) return false; /* set by the 'quit' operator */
return true;
}
/* call eval until quit */
void run (state *st) {
int ret;
printf("beginning run\n");
st->quit = false;
do
ret = eval(st);
while (ret);
}
And the testing:
if (1) { /* test string eval */
char *v[] = {
"10 dup add",
"/in {72 mul} def 2 in"
};
char **p;
for (p = v; (unsigned)(p-v) < sizeof v/sizeof*v; p++) {
pushe(consoper(st, "quit", NULL,0,0));
pushe(consstring(st, *p, strlen(*p)));
run(st);
stack_dump(st);
pushe(consoper(st, "quit", NULL,0,0));
pushe(consoper(st, "clear", NULL,0,0));
run(st);
}
}
And the glorious output showing the successful
definition and execution of a simple procedure:
792(2)01:39 AM:mark2 0> xpost
beginning run
q = <string 0:X--- 10 dup add n=10>
q = <string 0:X--- dup add n=7>
q = <string 0:X--- add n=3>
q = <string 0:X--- n=0>
q = <operator 0:X--- quit>
stack:
<integer 1:L--- 20>
beginning run
q = <operator 0:X--- clear>
q = <operator 0:X--- quit>
beginning run
q = <string 0:X--- /in {72 mul} def 2 in n=21>
q = <string 0:X--- {72 mul} def 2 in n=17>
q = <string 0:X--- def 2 in n=9>
q = <string 0:X--- 2 in n=4>
q = <string 0:X--- in n=2>
q = <array 0:X--- <0:0:0> 11136 1 1 <0>
>
q = <name 0:X--- 15:mul>
q = <string 0:X--- n=0>
q = <operator 0:X--- quit>
stack:
<integer 1:L--- 144>
beginning run
q = <operator 0:X--- clear>
q = <operator 0:X--- quit>
793(2)01:43 AM:mark2 0>
luser- -droog
stack, boolean, string, array, dictionary, type.
I've only put in the line edit special file and there's no
executive, So the testing block serves now as the
outer level of the interpreter. It looks like this:
if (1) { /* test file lineedit eval */
object cleanup;
cleanup = consarray(st, 2);
ARR(cleanup)[0] = consoper(st, "clear", NULL,0,0);
ARR(cleanup)[1] = consoper(st, "quit", NULL,0,0);
pushe(consoper(st, "quit", NULL,0,0));
pushe(consstring(st, STR_CNT("(%lineedit) run")));
pushe(consname(st, "prompt"));
run(st);
stack_dump(st);
pushe(cleanup); run(st);
}
So the following (after the big list of operators)
shows when happens when I run it and hit ctrl-D to
end the input file.
It successfully triggers 2 errors (invalidfilename
for the empty %lineedit file, and the secret "internal"
error for when stop finds no stopped context to
remove).
cc -Wall -Wextra -c -o op.o op.c
cc -Wall -Wextra -o xpost core.o dic.o file.o tok.o op.o -lm
1375(1)04:11 AM:mark2 0> xpost
installed operator signatures:
any -1-pop-0-
any any -2-exch-2-
any -1-dup-2-
integer -1-copy-0-
array array -2-copy-1-
dict dict -2-copy-1-
string string -2-copy-1-
integer -1-index-1-
-0-clear-0-
-0-count-1-
-0-cleartomark-0-
-0-counttomark-1-
integer integer -2-add-1-
float float -2-add-1-
float float -2-div-1-
integer integer -2-idiv-1-
integer integer -2-mod-1-
integer integer -2-mul-1-
float float -2-mul-1-
integer integer -2-sub-1-
float float -2-sub-1-
integer -1-abs-1-
real -1-abs-1-
integer -1-neg-1-
real -1-neg-1-
integer -1-ceiling-1-
real -1-ceiling-1-
integer -1-floor-1-
real -1-floor-1-
integer -1-round-1-
real -1-round-1-
integer -1-truncate-1-
real -1-truncate-1-
float -1-sqrt-1-
float float -2-atan-1-
float -1-cos-1-
float -1-sin-1-
float float -2-exp-1-
integer -1-array-1-
array -1-length-1-
dict -1-length-1-
string -1-length-1-
array integer -2-get-1-
dict any -2-get-1-
string integer -2-get-1-
array integer any -3-put-0-
dict any any -3-put-1-
string integer integer -3-put-0-
array integer integer -3-getinterval-1-
string integer integer -3-getinterval-1-
array integer array -3-putinterval-0-
string integer string -3-putinterval-0-
array -1-aload-1-
array -1-astore-1-
array proc -2-forall-1-
dict proc -2-forall-2-
string proc -2-forall-1-
integer -1-dict-1-
dict -1-maxlength-1-
dict -1-begin-0-
-0-end-0-
any any -2-def-0-
any -1-load-1-
any any -2-store-0-
dict any -2-known-1-
any -1-where-2-
-0-currentdict-1-
-0-countdictstack-1-
array -1-dictstack-1-
integer -1-string-1-
string string -2-anchorsearch-3-
string string -2-search-4-
string -1-token-2-
file -1-token-2-
any any -2-eq-1-
any any -2-ne-1-
number number -2-ge-1-
string string -2-ge-1-
number number -2-gt-1-
string string -2-gt-1-
number number -2-le-1-
string string -2-le-1-
number number -2-lt-1-
string string -2-lt-1-
boolean boolean -2-and-1-
integer integer -2-and-1-
boolean -1-not-1-
integer -1-not-1-
boolean boolean -2-or-1-
integer integer -2-or-1-
boolean boolean -2-xor-1-
integer integer -2-xor-1-
integer integer -2-bitshift-1-
any -1-exec-0-
boolean proc -2-if-0-
boolean proc proc -3-ifelse-0-
integer proc -2-repeat-0-
proc -1-loop-0-
-0-exit-0-
-0-countexecstack-1-
boolean -1-execstack-1-
-0-quit-0-
-0-stop-0-
any -1-stopped-0-
any -1-type-1-
any -1-cvlit-1-
any -1-cvx-1-
any -1-xcheck-1-
array -1-executeonly-1-
file -1-executeonly-1-
string -1-executeonly-1-
array -1-noaccess-1-
dict -1-noaccess-1-
file -1-noaccess-1-
string -1-noaccess-1-
array -1-readonly-1-
dict -1-readonly-1-
file -1-readonly-1-
string -1-readonly-1-
array -1-rcheck-1-
dict -1-rcheck-1-
file -1-rcheck-1-
string -1-rcheck-1-
array -1-wcheck-1-
dict -1-wcheck-1-
file -1-wcheck-1-
string -1-wcheck-1-
real -1-cvi-1-
string -1-cvi-1-
integer -1-cvi-1-
string -1-cvn-1-
integer -1-cvr-1-
string -1-cvr-1-
real -1-cvr-1-
number integer string -3-cvrs-1-
integer string -2-cvs-1-
real string -2-cvs-1-
boolean string -2-cvs-1-
string string -2-cvs-1-
name string -2-cvs-1-
operator string -2-cvs-1-
any string -2-cvs-1-
string string -2-file-1-
file -1-closefile-0-
file -1-read-2-
file integer -2-write-0-
file -1-bytesavailable-1-
-0-flush-0-
file -1-status-1-
string -1-print-0-
boolean -1-echo-0-
-0-save-1-
save -1-restore-0-
-0-vmstatus-3-
proc -1-bind-1-
155 signatures
100 opcodes
110 definitions in systemdict
> !ERROR: undefinedfilename in string string -2-file-1-
stack:
<string 1:L--- %lineedit n=9>
<string 1:L--- r n=1>
<name 0:X--- 112:undefinedfilename>
ERROR: no stopped context in 'stop'
stack:
<string 1:L--- %lineedit n=9>
<string 1:L--- r n=1>
<name 0:X--- 112:undefinedfilename>