diff -urN paflof/Makefile paflof-stepan/Makefile --- paflof/Makefile 2002-06-15 17:48:06.000000000 +0200 +++ paflof-stepan/Makefile 2002-06-23 12:05:58.000000000 +0200 @@ -1,7 +1,10 @@ -CFLAGS = -Wall -W -std=gnu9x -g -O2 # -pg +CC = gcc +NM = nm -B +CFLAGS = -Wall -std=gnu9x -g -O2 # -pg +# CFLAGS = -Wall -ansi -pedantic -DANSI LDFLAGS = -g # -pg -DICT = prim.in engine.in tests.in +DICT = prim.in engine.in unix.in tests.in %.s: %.c $(CC) $(CFLAGS) -g0 -fverbose-asm -S $< -o $@ @@ -13,9 +16,13 @@ paflof: paflof.o -paflof.o paflof.s: paflof.c prim.code prep.h dict.xt +paflof.o paflof.s: paflof.c prim.code prep.h types.h dict.xt + +types.h: conf.pl Makefile + CC='$(CC) $(CFLAGS)' NM='$(NM)' perl conf.pl + asm: paflof.s clean: - -rm paflof.[os] paflof dict.xt + -rm paflof.[os] paflof dict.xt types.h diff -urN paflof/conf.pl paflof-stepan/conf.pl --- paflof/conf.pl 1970-01-01 01:00:00.000000000 +0100 +++ paflof-stepan/conf.pl 2002-06-23 12:22:21.000000000 +0200 @@ -0,0 +1,172 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; + +my $CC; +my $NM; +my %types; +my $filename = '.test.c'; +my $o_filename = '.test.o'; +my $h_filename = '.types.h'; +my $logfile = 'conf.log'; + +sub check_size { + my ($what, $attr, $include) = @_; + my $ret = 0; + + # create .test.c file + open(F, ">$filename") || die "can't open $filename for writing !\n"; + print F "#include <$include>\n" if ($include ne ""); + print(F "$what test $attr;\n"); + close(F); + + # compile it and check size in object file + system("$CC -o $o_filename -c $filename >> $logfile 2>&1"); + open(F, "$NM ./$o_filename 2>/dev/null|") || die "can't open nm in pipe !\n"; + while () { + next unless / test/; + $_ =~ s/^(.*?) .*/$1/g; + $_ =~ s/\n//g; + $ret = $_; + } + close(F); + + # clean up + unlink ($filename); + unlink ($o_filename); + + return hex($ret); +} + +sub check_include { + my $what=shift; + my $ret=0; + + print("Checking include $what... "); + open (F, ">$filename") || die "can't open $filename for writing !\n"; + print (F "#include <$what>\n"); + close (F); + system("$CC -o $o_filename -c $filename") and do { + print("not "); + $ret=1; + }; + unlink($o_filename); + print ("found.\n"); + return $ret; +} + +sub find_type { + my ($size, $signed) = @_; + my $ret="none"; + + printf("Looking for data type $size bytes (".($signed!=1?"un":"")."signed)..."); + foreach (keys %types) { + if ($types{$_}[0] eq $size && $types{$_}[1] eq $signed) { + print("$_\n"); + return $_; + } + } + print("none.\n"); + print("WARNING: Your build environment did not pass the consistency check!\n"); + return "uint64_t"; +} + + +# main program + +print("Checking for C compiler... "); +$CC="gcc -std=gnu9x"; +if (defined($ENV{'CC'})) { + $CC=$ENV{'CC'}; +} + +print("$CC\n"); +print("Checking for nm... "); +$NM="nm -f bsd"; +if (defined($ENV{'NM'})) { + $NM=$ENV{'NM'}; +} +print("$NM\n"); + + +my $pointer; +my $include; + +open I, "> $h_filename" || die "\can't open $h_filename for writing !"; +print I "/* THIS FILE IS AUTOGENERATED. IT WILL BE OVERWRITTEN. */\n\n"; + +my $have_stdint=check_include("stdint.h"); + +if ($have_stdint eq 0) { + %types = ( 'uint8_t' => [ 0, 0 ], 'uint16_t' => [ 0, 0 ], + 'uint32_t' => [ 0, 0 ], 'uint64_t' => [ 0, 0 ], + 'int32_t' => [ 0, 1 ], 'int64_t' => [ 0, 1 ], + 'uint128_t' => [ 0, 0 ], 'uintptr_t' => [ 0, 2 ] ); + # 'intmax_t' => [ 0, 1 ], 'uintmax_t' => [ 0, 0 ] ); + + print I "#include \n\n"; + print ("\nGood. Checking stdint types.\n"); + + $include='stdint.h'; + $pointer='uintptr_t'; +} else { + %types = ( 'unsigned char' => [ 0, 0 ], 'unsigned short' => [ 0, 0 ], + 'unsigned int' => [ 0, 0 ], 'unsigned long' => [ 0, 0 ], + 'int' => [ 0, 1 ], 'long' => [ 0, 1 ], + 'void *' => [ 0, 2 ], 'long long' => [ 0, 1 ], + 'unsigned long long' => [ 0, 0 ] ); + + $include=''; + $pointer='void *'; +}; + +$types{'int __attribute__ ((mode (TI)))'} = [ 0, 1 ]; +$types{'unsigned int __attribute__ ((mode (TI)))'} = [ 0, 0 ]; + +my $ptrsize=$types{$pointer}[0]; + +foreach my $i (keys %types) { + print("Checking size of $i... "); + $types{$i}[0]=check_size($i, "", "stdint.h"); + print($types{$i}[0]==0 ? "unknown.\n" : $types{$i}[0]." bytes.\n"); +}; + +print("\nOk. Now looking for matching data types.\n"); +$ptrsize=$types{$pointer}[0]; +print("Cell size is $ptrsize bytes. Pointer type is $pointer.\n"); + +my $typec=find_type(1,0); +my $typew=find_type(2,0); +my $typel=find_type(4,0); +my $typeu=find_type($ptrsize,0); +my $typen=find_type($ptrsize,1); +my $typedu=find_type($ptrsize*2,0); +my $typed=find_type($ptrsize*2,1); +print (I "typedef $typec type_c;\n"); +print (I "typedef $typew type_w;\n"); +print (I "typedef $typel type_l;\n"); +print (I "typedef $typeu type_u;\n"); +print (I "typedef $typen type_n;\n"); +print (I "typedef $typedu type_du;\n"); +print (I "typedef $typed type_d;\n"); + +# Check for restrict keyword. +my $answer="no"; +print("\nChecking whether we can use the restrict keyword (C99)... "); +print(I "\n#define __RESTRICT__ "); +if (check_size("char *restrict","", "") != 0) { + $answer="yes"; + print I "restrict"; +} +print("$answer.\n"); +print(I "\n"); + +# We're done. close and rename file. +close(I); + +rename('.types.h','types.h'); +unlink($logfile); + +print("\nConfiguration finished.\n\n"); + diff -urN paflof/dict.source paflof-stepan/dict.source --- paflof/dict.source 2002-06-16 08:24:25.000000000 +0200 +++ paflof-stepan/dict.source 2002-06-23 11:56:04.000000000 +0200 @@ -188,10 +188,10 @@ prim w! prim l@ prim l! - unaligned-w@ - unaligned-w! - unaligned-l@ - unaligned-l! +prim unaligned-w@ +prim unaligned-w! +prim unaligned-l@ +prim unaligned-l! engine comp dump engine +! @@ -489,7 +489,7 @@ */ engine constant - 2constant +engine 2constant engine value engine variable engine buffer: @@ -559,7 +559,7 @@ engine recursive engine recurse forth - environment + environment? /* diff -urN paflof/engine.in paflof-stepan/engine.in --- paflof/engine.in 2002-06-23 12:10:16.000000000 +0200 +++ paflof-stepan/engine.in 2002-06-21 15:39:20.000000000 +0200 @@ -1,4 +1,4 @@ -// some common constant numbers +/* some common constant numbers */ con(-1 -1) con(0 0) con(1 1) @@ -11,30 +11,30 @@ con(H#FFFF 0xffff) con(D#10 0x0a) -// 1.1 +/* 1.1 */ col(TUCK SWAP OVER) col(2DUP OVER OVER) col(3DUP 2 PICK 2 PICK 2 PICK) col(2OVER 3 PICK 3 PICK) -// 1.2 +/* 1.2 */ col(2DROP DROP DROP) col(3DROP DROP DROP DROP) col(NIP SWAP DROP) col(CLEAR 0 DEPTH!) -// 1.3 +/* 1.3 */ col(ROT >R SWAP R> SWAP) col(-ROT SWAP >R SWAP R>) col(2SWAP >R -ROT R> -ROT) col(2ROT >R >R 2SWAP R> R> 2SWAP) col(ROLL DUP ?DUP ?BRANCH(6) ROT >R 1 - BRANCH(-9) ?DUP ?BRANCH(6) R> -ROT 1 - BRANCH(-9)) -// 7 +/* 7 */ con(TRUE -1) con(FALSE 0) -// 6 +/* 6 */ col(<= > NOT) col(<> = NOT) col(>= < NOT) @@ -49,7 +49,7 @@ col(U<= U> NOT) col(U>= U< NOT) -// 2.1 +/* 2.1 */ col(NEGATE 0 SWAP -) col(ABS DUP 0< ?BRANCH(1) NEGATE) col(MAX 2DUP < ?BRANCH(1) SWAP DROP) @@ -62,14 +62,14 @@ col(EVEN 1+ -1 AND) col(BOUNDS OVER + SWAP) -// 2.2 +/* 2.2 */ col(2* 1 <<) col(U2/ 1 >>) col(2/ 1 >>A) col(LSHIFT <<) col(RSHIFT >>) -// 2.3 +/* 2.3 */ col(S>D DUP 0< ?BRANCH(2) -1 EXIT 0) col(DNEGATE 0 0 2SWAP D-) col(DABS DUP 0< ?BRANCH(1) DNEGATE) @@ -77,14 +77,14 @@ col(SM/REM OVER >R >R DABS R@ ABS UM/MOD R> 0< ?BRANCH(1) NEGATE R> 0< ?BRANCH(4) NEGATE SWAP NEGATE SWAP) col(FM/MOD DUP >R 2DUP XOR 0< >R SM/REM OVER 0<> R> AND ?BRANCH(6) 1- SWAP R> + SWAP EXIT R> DROP) -// 2.1 +/* 2.1 */ col(/MOD >R S>D R> FM/MOD) col(/ /MOD NIP) col(MOD /MOD DROP) col(*/MOD >R M* R> FM/MOD) col(*/ */MOD NIP) -// 2.4 +/* 2.4 */ col(WBSPLIT DUP H#FF AND SWAP 8 >>) col(LWSPLIT DUP H#FFFF AND SWAP H#10 >>) col(LBSPLIT LWSPLIT SWAP WBSPLIT ROT WBSPLIT) @@ -95,7 +95,7 @@ col(LWFLIP LWSPLIT SWAP WLJOIN) col(LBFLIP LBSPLIT SWAP 2SWAP SWAP BLJOIN) -// 2.5 +/* 2.5 */ con(/C 1) con(/W 2) con(/L 4) @@ -118,7 +118,7 @@ col(CELLS /N*) col(ALIGNED /N 1- + /N NEGATE AND) -// 3.1 +/* 3.1 */ col(+! TUCK @ + SWAP !) col(COMP 0 DO?DO(27) OVER I + C@ OVER I + C@ 2DUP < ?BRANCH(6) 2DROP UNLOOP 2DROP LIT(-1) EXIT > ?BRANCH(4) UNLOOP 2DROP 1 EXIT DOLOOP(-27) 2DROP 0) col(OFF FALSE SWAP !) @@ -136,14 +136,14 @@ col(BLANK LIT(0x20) FILL) col(ERASE LIT(0x00) FILL) -// 8.6 +/* 8.6 */ var(CATCHER 0) var(ABORT"-STR 0) col(CATCH DEPTH >R CATCHER @ >R RDEPTH CATCHER ! EXECUTE R> CATCHER ! R> DROP 0) col(THROW ?DUP ?BRANCH(12) CATCHER @ RDEPTH! R> CATCHER ! R> SWAP >R DEPTH! DROP R>) col(ABORT -1 THROW) -// 4.1 +/* 4.1 */ var(#TIB TIBSIZE) val(IB 0) var(#IB 0) @@ -152,45 +152,45 @@ var(>IN 0) col(TERMINAL TIB DOTO IB #TIB @ #IB ! 0 DOTO SOURCE-ID) -// 4.3 +/* 4.3 */ con(BL 0x20) con(BELL 7) con(BS 8) con(CARRET 0x0d) con(LINEFEED 0x0a) -// 4.4 +/* 4.4 */ dfr(EMIT) col(TYPE BOUNDS DO?DO(5) I C@ EMIT DOLOOP(-5)) -// 4.5 +/* 4.5 */ col(CR LINEFEED EMIT) col(SPACE BL EMIT) col(SPACES 0 DO?DO(3) SPACE DOLOOP(-3)) -// 4.8 +/* 4.8 */ col(COUNT DUP 1 + SWAP C@) col(UPC DUP LIT('a') LIT('z') BETWEEN ?BRANCH(3) LIT(0x20) - ) col(LCC DUP LIT('A') LIT('Z') BETWEEN ?BRANCH(3) LIT(0x20) + ) -// 4.2 +/* 4.2 */ dfr(KEY) col(ACCEPT TUCK 0 DO?DO(21) KEY DUP LINEFEED = ?BRANCH(7) SPACE DROP DROP DROP I UNLOOP EXIT DUP EMIT OVER C! 1 + DOLOOP(-21) DROP KEY LINEFEED = ?BRANCH(-5) CR) var(SPAN 0) col(EXPECT ACCEPT SPAN !) col(REFILL SOURCE-ID 0= ?BRANCH(7) SOURCE EXPECT 0 >IN ! TRUE EXIT SOURCE-ID -1 = ?BRANCH(2) FALSE EXIT LIT(0x6502) THROW) -// 5.1 +/* 5.1 */ var(BASE 16) col(DECIMAL D#10 BASE !) col(HEX H#10 BASE !) col(OCTAL 8 BASE !) -// for constructing pictures +/* for constructing pictures */ col(PAD HERE LIT(256) +) col(TODIGIT DUP LIT(9) > ?BRANCH(3) LIT(0x27) + LIT(0x30) +) -// 5.4 +/* 5.4 */ col(<# PAD DUP !) col(HOLD PAD DUP @ 1- TUCK SWAP ! C!) col(SIGN 0< ?BRANCH(3) LIT('-') HOLD) @@ -203,7 +203,7 @@ col(U#> DROP PAD DUP @ TUCK -) col((U.) <# U#S U#>) -// 5.3 +/* 5.3 */ col(. (.) TYPE SPACE) col(S. .) col(U. (U.) TYPE SPACE) @@ -214,12 +214,12 @@ col(.S DEPTH 0 DO?DO(8) DEPTH I - 1- PICK . DOLOOP(-8)) col(? @ .) -// 5.2 +/* 5.2 */ col(DIGIT OVER UPC DUP LIT('A') LIT('Z') BETWEEN ?BRANCH(3) LIT(7) - LIT(0x30) - DUP ROT 0 SWAP WITHIN ?BRANCH(4) NIP TRUE BRANCH(2) DROP FALSE) col(>NUMBER DUP 0= ?BRANCH(1) EXIT OVER C@ BASE @ DIGIT ?BRANCH(23) SWAP >R SWAP >R >R BASE @ U* SWAP BASE @ UM* ROT + R> 0 D+ R> CHAR+ R> 1- BRANCH(-35) DROP) col($NUMBER DUP 0= ?BRANCH(4) DROP DROP TRUE EXIT >R DUP >R C@ LIT('-') = DUP ?BRANCH(15) R> CHAR+ R> 1- DUP 0= ?BRANCH(5) DROP DROP DROP TRUE EXIT >R >R 0 0 R> R> >NUMBER NIP 0= ?BRANCH(7) DROP SWAP ?BRANCH(1) NEGATE FALSE EXIT DROP DROP DROP TRUE) -// 9.2.1 +/* 9.2.1 */ col(ALLOT HERE + HERE!) col(, HERE ! /N ALLOT) col(C, HERE C! /C ALLOT) @@ -227,7 +227,7 @@ col(L, HERE L! /L ALLOT) col(ALIGN HERE /N 1- AND ?BRANCH(4) 0 C, BRANCH(-10)) -// for dictionary +/* for dictionary */ var(LATEST 0) var(LAST 0) @@ -258,7 +258,7 @@ col(CHAR PARSE-WORD DROP C@) imm(( LIT(')') PARSE 2DROP) -//imm(\ SPAN @ >IN !) +/* imm(\ SPAN @ >IN !) */ imm(\ LINEFEED PARSE 2DROP) var(STATE 0) @@ -270,31 +270,31 @@ col(:NONAME ALIGN HERE DOTICK DOCOL COMPILE, ]) com(; DOTICK EXIT COMPILE, REVEAL [) -// 4.3 +/* 4.3 */ com([CHAR] PARSE-WORD DROP C@ DOTICK DOLIT COMPILE, COMPILE,) -// 4.7 +/* 4.7 */ com(C" LIT('"') PARSE DOTICK SLITERAL COMPILE, DUP C, BOUNDS DO?DO(5) I C@ C, DOLOOP(-5) ALIGN) imm(S" STATE? ?BRANCH(5) C" DOTICK COUNT COMPILE, EXIT POCKET LIT('"') PARSE SWAP 2 PICK 2 PICK MOVE) -// 4.4 +/* 4.4 */ com(." S" DOTICK TYPE COMPILE,) com(.( LIT(')') PARSE TYPE) -// 8.1 +/* 8.1 */ com(RESOLVE-ORIG HERE OVER CELL+ - SWAP !) com(AHEAD DOTICK DOBRANCH COMPILE, HERE 0 COMPILE,) com(IF DOTICK DO?BRANCH COMPILE, HERE 0 COMPILE,) com(THEN RESOLVE-ORIG) com(ELSE DOTICK DOBRANCH COMPILE, HERE 0 COMPILE, SWAP RESOLVE-ORIG) -// 8.2 +/* 8.2 */ com(CASE 0) com(ENDCASE DOTICK DROP COMPILE, ?DUP ?BRANCH(5) 1- SWAP THEN BRANCH(-8)) com(OF 1+ >R DOTICK OVER COMPILE, DOTICK = COMPILE, IF DOTICK DROP COMPILE, R>) com(ENDOF >R ELSE R>) -// 8.3 +/* 8.3 */ com(RESOLVE-DEST HERE CELL+ - COMPILE,) com(BEGIN HERE) com(AGAIN DOTICK DOBRANCH COMPILE, RESOLVE-DEST) @@ -302,7 +302,7 @@ com(WHILE IF SWAP) com(REPEAT AGAIN THEN) -// 8.4 +/* 8.4 */ var(LEAVES 0) com(RESOLVE-LOOP LEAVES @ ?DUP ?BRANCH(10) DUP @ SWAP HERE OVER - SWAP ! BRANCH(-13) HERE - COMPILE, LEAVES !) com(DO LEAVES @ HERE DOTICK DODO COMPILE, 0 LEAVES !) @@ -312,7 +312,7 @@ com(LEAVE DOTICK DODOLEAVE COMPILE, LEAVES @ HERE LEAVES ! COMPILE,) com(?LEAVE DOTICK DODO?LEAVE COMPILE, LEAVES @ HERE LEAVES ! COMPILE,) -// 8.5 +/* 8.5 */ col(SAVE-SOURCE R> IB >R #IB @ >R SOURCE-ID >R SPAN @ >R >IN @ >R >R) col(RESTORE-SOURCE R> R> >IN ! R> SPAN ! R> DOTO SOURCE-ID R> #IB ! R> DOTO IB >R) @@ -328,7 +328,7 @@ col(EVALUATE SAVE-SOURCE -1 DOTO SOURCE-ID DUP #IB ! SPAN ! DOTO IB INTERPRET RESTORE-SOURCE) col(EVAL EVALUATE) -// 8.6 +/* 8.6 */ col(DOABORT" SWAP ?BRANCH(5) ABORT"-STR ! LIT(-2) THROW DROP) com(ABORT" C" DOTICK DOABORT" COMPILE,) @@ -341,17 +341,18 @@ dfr(UNMAP-FILE) col(INCLUDED MAP-FILE 2DUP >R >R BOUNDS DO?DO(21) R> R@ SWAP >R R@ - R@ SWAP 2DUP LINEFEED FINDCHAR ?BRANCH(1) NIP DUP >R EVALUATE R> 1+ DO+LOOP(-21) R> R> UNMAP-FILE) -// 9.2.4 +/* 9.2.4 */ col(NOOP) -// 9.1 +/* 9.1 */ col($CREATE HEADER DOTICK DODOES COMPILE, DOTICK NOOP CELL+ COMPILE, REVEAL) col(CREATE PARSE-WORD $CREATE) col(DODOES> R> CELL+ LATEST @ >XCODE CELL+ !) imm(DOES> DOTICK DODOES> COMPILE,) -// 9.1 +/* 9.1 */ col(CONSTANT PARSE-WORD HEADER DOTICK DOCON COMPILE, COMPILE, REVEAL) +col(2CONSTANT CREATE COMPILE, COMPILE, DODOES> 2@ REVEAL) col(VALUE PARSE-WORD HEADER DOTICK DOVAL COMPILE, COMPILE, REVEAL) col(VARIABLE PARSE-WORD HEADER DOTICK DOVAR COMPILE, 0 COMPILE, REVEAL) col(BUFFER: PARSE-WORD HEADER DOTICK DOBUFFER: COMPILE, ALLOT REVEAL) @@ -360,17 +361,17 @@ col(STRUCT 0) col(FIELD PARSE-WORD HEADER DOTICK DOFIELD COMPILE, OVER COMPILE, + REVEAL) -// 9.2.2 +/* 9.2.2 */ com(LITERAL DOTICK DOLIT COMPILE, COMPILE,) col(COMPILE R> CELL+ DUP @ COMPILE, >R) com([COMPILE] ' COMPILE,) com(POSTPONE PARSE-WORD $FIND 0= DOTICK UNDEFINED-STR DOABORT" IMMEDIATE? NOT ?BRANCH(6) DOTICK DOTICK COMPILE, COMPILE, DOTICK COMPILE, COMPILE,) -// 9.2.3 +/* 9.2.3 */ com(['] ' DOTICK DOTICK COMPILE, COMPILE,) col(FIND DUP COUNT $FIND ?BRANCH(9) ROT DROP TRUE SWAP IMMEDIATE? ?BRANCH(1) NEGATE EXIT FALSE EXIT) -// 9.2.4 +/* 9.2.4 */ imm(TO ' STATE? ?BRANCH(5) DOTICK DOTO COMPILE, COMPILE, EXIT CELL+ !) col(BEHAVIOR CELL+ @) col(>BODY 2 CELLS +) diff -urN paflof/paflof.c paflof-stepan/paflof.c --- paflof/paflof.c 2002-06-16 08:51:59.000000000 +0200 +++ paflof-stepan/paflof.c 2002-06-23 12:20:20.000000000 +0200 @@ -1,16 +1,23 @@ -//#define DEBUG_STACKS - #include #include +/* #include */ +#ifdef ANSI +#define __USE_XOPEN_EXTENDED +#define __USE_MISC +#define __USE_POSIX +#define __USE_POSIX199309 +#endif #include -#include #include +#include #include #include #include #include "types.h" +/* #define DEBUG_STACKS */ +/* #define HANDLE_SEGV */ #define DATA_STACK_SIZE 1024 #define RETURN_STACK_SIZE 256 @@ -18,13 +25,23 @@ #define POCKETSIZE 256 #define TOTAL_MEM_SIZE 1048576 +#define CELLSIZE (sizeof(type_u) / sizeof(type_c)) + +typedef union cell { + type_n n; + type_u u; + void *a; + type_c c[CELLSIZE]; + type_w w[CELLSIZE/2]; + type_l l[CELLSIZE/4]; +} cell; struct interpreter { - cell *restrict data_stack; - cell *restrict return_stack; - cell *restrict dictionary; - char *restrict tib; - char *restrict pockets; + cell * __RESTRICT__ data_stack; + cell * __RESTRICT__ return_stack; + cell * __RESTRICT__ dictionary; + char * __RESTRICT__ tib; + char * __RESTRICT__ pockets; void *here; }; @@ -56,6 +73,7 @@ ip = xt_START_PAFLOF; #include "prim.code" + #include "unix.code" } @@ -94,12 +112,12 @@ hole(); i->return_stack = data(RETURN_STACK_SIZE * CELLSIZE); hole(); - i->dictionary = data(CELLSIZE); // fake size; it'll take all it can get + i->dictionary = data(CELLSIZE); /* fake size; it'll take all it can get */ mem = (void *)(((type_n)end - 1) & -page_size); hole(); - i->tib = malloc(TIBSIZE); // this should be pure forth - i->pockets = malloc(POCKETSIZE * 2); // this should be pure forth + i->tib = malloc(TIBSIZE); /* this should be pure forth */ + i->pockets = malloc(POCKETSIZE * 2); /* this should be pure forth */ i->here = i->dictionary; return i; @@ -108,9 +126,11 @@ static void fini_engine(struct interpreter *i) { -// free(i->data_stack); -// free(i->return_stack); -// free(i->dictionary); +#if 0 + free(i->data_stack); + free(i->return_stack); + free(i->dictionary); +#endif free(i->tib); free(i->pockets); } @@ -173,8 +193,10 @@ interpreter = init_engine(); -// init_signals(); - +#ifdef HANDLE_SEGV + init_signals(); +#endif + for (i = 0; i < 1; i++) run_engine(interpreter); { cell *p; for (p = interpreter->dictionary; (void *)p < interpreter->here; p++) fprintf(stderr, "%p: 0x%0*lx\n", p, (int)(2 * CELLSIZE), (long)p->n); diff -urN paflof/prim.code paflof-stepan/prim.code --- paflof/prim.code 2002-06-16 08:24:25.000000000 +0200 +++ paflof-stepan/prim.code 2002-06-23 11:46:55.000000000 +0200 @@ -26,7 +26,7 @@ - // start interpreting + /* start interpreting */ NEXT0; @@ -34,7 +34,7 @@ -// debugging stuff +/* debugging stuff */ code__X2e_STACKS: { debug_stacks(); @@ -43,59 +43,13 @@ - - - -// temporary; should be in their own file -code_BYE: - { - return; - } -code_UNIX_X2d_KEY: - { - (++dp)->n = fgetc(stdin); - NEXT; - } -code_UNIX_X2d_EMIT: - { - fputc((dp--)->u, stdout) ; - NEXT; - } -code_UNIX_X2d_MAP_X2d_FILE: - { - char name[256]; - int fd; - int length; - void *map; - memcpy(name, (dp - 1)->a, dp->u); - name[dp->u] = 0; - fd = open(name, O_RDONLY); - length = lseek(fd, 0, SEEK_END); - map = mmap(0, length, PROT_READ, MAP_SHARED, fd, 0); - close(fd); - (dp - 1)->a = map; - dp->u = length; - NEXT; - } -code_UNIX_X2d_UNMAP_X2d_FILE: - { - munmap((dp - 1)->a, dp->u); - dp -= 2; - NEXT; - } - - - - - - -// for terminal input; should be a BUFFER: +/* for terminal input; should be a BUFFER: */ code_TIB: { (++dp)->a = interpreter->tib; NEXT; } -// for pockets; should be a BUFFER: +/* for pockets; should be a BUFFER: */ code_POCKETS: { (++dp)->a = interpreter->pockets; @@ -107,7 +61,7 @@ -// codefields +/* codefields */ code_DOCOL: { (++rp)->a = ip; @@ -150,7 +104,7 @@ -// literals +/* literals */ code_LIT: code_DOTICK: { @@ -176,7 +130,7 @@ -// branching +/* branching */ code_BRANCH: { type_n dis = (++ip)->n; @@ -196,7 +150,7 @@ -// 1.1 +/* 1.1 */ code_DUP: { cell x = *dp; @@ -227,7 +181,7 @@ -// 1.2 +/* 1.2 */ code_DROP: { --dp; @@ -239,7 +193,7 @@ -// 1.3 +/* 1.3 */ code_SWAP: { cell a = *(dp - 1); @@ -253,7 +207,7 @@ -// 1.4 +/* 1.4 */ code__X3e_R: { *++rp = *dp--; @@ -275,7 +229,7 @@ -// 1.5 +/* 1.5 */ code_DEPTH: { dp++; @@ -303,7 +257,7 @@ -// 2.1 +/* 2.1 */ code__X2b: { (dp - 1)->n += dp->n; @@ -334,7 +288,7 @@ -// 2.2 +/* 2.2 */ code__X3c_X3c: { (dp - 1)->u <<= dp->n; @@ -383,7 +337,7 @@ -// 2.3 +/* 2.3 */ #define d_to_stack(d, s) do { \ (s)->u = (d); \ @@ -451,7 +405,7 @@ -// 3.1 +/* 3.1 */ code__X40: { dp->u = *(type_u *)(dp->a); @@ -501,12 +455,66 @@ NEXT; } +code_UNALIGNED_X2d_W_X40: + { + type_c *a = dp->a; +#ifdef __LITTLE_ENDIAN + dp->u= *a | *(a+1)<<8; +#else + dp->u= *a<<8 | *(a+1); +#endif + NEXT; + } + +code_UNALIGNED_X2d_W_X21: + { + type_c *a = dp->a; + type_w v = (--dp)->u; +#ifdef __LITTLE_ENDIAN + *a = v & 0xff; + *(a+1) = v >> 8; +#else + *a = v >> 8; + *(a+1) = v & 0xff; +#endif + dp--; + NEXT; + } + +code_UNALIGNED_X2d_L_X40: + { + type_c *a = dp->a; +#ifdef __LITTLE_ENDIAN + dp->u= *a | *(a+1)<<8 | *(a+2)<<16 | *(a+3)<<24; +#else + dp->u= *a<<24 | *(a+1)<<16 | *(a+2)<<8 | *(a+3); +#endif + NEXT; + } +code_UNALIGNED_X2d_L_X21: + { + type_c *a = dp->a; + type_w v = (--dp)->u; +#ifdef __LITTLE_ENDIAN + *a = (v) & 0xff; + *(a+1) = (v >> 8) & 0xff; + *(a+2) = (v >> 16) & 0xff; + *(a+3) = (v >> 24) & 0xff; +#else + *a = (v >> 24) & 0xff; + *(a+1) = (v >> 16) & 0xff; + *(a+2) = (v >> 8) & 0xff; + *(a+3) = (v) & 0xff; +#endif + dp--; + NEXT; + } -// 6 +/* 6 */ code__X3c: { cell a = *--dp; @@ -548,7 +556,7 @@ -// 8.4 +/* 8.4 */ code_DODO: { cell i = *dp--; @@ -637,7 +645,7 @@ -// 8.5 +/* 8.5 */ code_EXIT: { ip = (rp--)->a; @@ -654,7 +662,7 @@ -// 9.2.1 +/* 9.2.1 */ code_HERE: { (++dp)->a = interpreter->here; diff -urN paflof/prim.in paflof-stepan/prim.in --- paflof/prim.in 2002-06-16 08:24:25.000000000 +0200 +++ paflof-stepan/prim.in 2002-06-23 12:05:38.000000000 +0200 @@ -1,29 +1,22 @@ -// debugging stuff +/* debugging stuff */ cod(.STACKS) -// temporary; should be in their own file -cod(BYE) -cod(UNIX-KEY) -cod(UNIX-EMIT) -cod(UNIX-MAP-FILE) -cod(UNIX-UNMAP-FILE) - -// for terminal input; should be a BUFFER: +/* for terminal input; should be a BUFFER: */ cod(TIB) -// for pockets; should be a BUFFER: +/* for pockets; should be a BUFFER: */ cod(POCKETS) -// literals implementation +/* literals implementation */ cod(LIT) _ADDING _N cod(DOTICK) cod(SLITERAL) cod(DOTO) -// branching implementation +/* branching implementation */ cod(BRANCH) _ADDING _O cod(?BRANCH) _ADDING _O @@ -31,36 +24,36 @@ -// 1.1 +/* 1.1 */ cod(DUP) cod(OVER) cod(?DUP) cod(PICK) -// 1.2 +/* 1.2 */ cod(DROP) -// 1.3 +/* 1.3 */ cod(SWAP) -// 1.4 +/* 1.4 */ cod(>R) cod(R>) cod(R@) -// 1.5 +/* 1.5 */ cod(DEPTH) cod(DEPTH!) cod(RDEPTH) cod(RDEPTH!) -// 2.1 +/* 2.1 */ cod(+) cod(-) cod(*) cod(U*) -// 2.2 +/* 2.2 */ cod(<<) cod(>>) cod(>>A) @@ -70,15 +63,15 @@ cod(INVERT) cod(NOT) -// 2.3 +/* 2.3 */ cod(D+) cod(D-) cod(UM*) cod(M*) -// for building some divs +/* for building some divs */ cod(MU/MOD) -// 3.1 +/* 3.1 */ cod(@) cod(!) cod(C@) @@ -87,15 +80,20 @@ cod(W!) cod(L@) cod(L!) +cod(UNALIGNED-W@) +cod(UNALIGNED-W!) +cod(UNALIGNED-L@) +cod(UNALIGNED-L!) + -// 6 +/* 6 */ cod(<) cod(>) cod(=) cod(U<) cod(U>) -// 8.4 +/* 8.4 */ cod(DODO) cod(DO?DO) _ADDING _O cod(DOLOOP) _ADDING _O @@ -106,10 +104,10 @@ cod(I) cod(J) -// 8.5 +/* 8.5 */ cod(EXIT) cod(EXECUTE) -// 9.2.1 +/* 9.2.1 */ cod(HERE) cod(HERE!) diff -urN paflof/tests.in paflof-stepan/tests.in --- paflof/tests.in 2002-06-16 08:24:25.000000000 +0200 +++ paflof-stepan/tests.in 2002-06-20 13:37:55.000000000 +0200 @@ -48,7 +48,7 @@ col(TEST23 SOURCE ACCEPT DUP . CR TIB SWAP TYPE CR) col(TEST23B SOURCE EXPECT SPAN @ . CR TIB SPAN @ TYPE CR) -//col(TEST24 DOTICK _A(xt_TEST24) DUP LATEST ! . CR WORDS CR) +/* col(TEST24 DOTICK _A(xt_TEST24) DUP LATEST ! . CR WORDS CR) */ col(TEST24 LATEST . CR WORDS CR) str(TEST25S1 "WOORDJE1") @@ -70,5 +70,5 @@ col(UNIXSTART DOTICK UNIX-KEY DOTO KEY DOTICK UNIX-EMIT DOTO EMIT DOTICK UNIX-MAP-FILE DOTO MAP-FILE DOTICK UNIX-UNMAP-FILE DOTO UNMAP-FILE) col(DICTSTART DOLIT _A(xt_DICTSTART) LATEST ! REVEAL) -//static cell xt_START_PAFLOF[] = { START TEST_X5f_ALL QUIT }; +/* static cell xt_START_PAFLOF[] = { START TEST_X5f_ALL QUIT }; */ static cell xt_START_PAFLOF[] = { DICTSTART UNIXSTART QUIT }; diff -urN paflof/types.h paflof-stepan/types.h --- paflof/types.h 2002-06-06 18:34:12.000000000 +0200 +++ paflof-stepan/types.h 1970-01-01 01:00:00.000000000 +0100 @@ -1,30 +0,0 @@ -#if 1 -#include - -typedef uint8_t type_c; // 1 byte -typedef uint16_t type_w; // 2 bytes -typedef uint32_t type_l; // 4 bytes -typedef intptr_t type_n; // cell size -typedef uintptr_t type_u; // cell size -typedef intmax_t type_d; // 2 * cell size -typedef uintmax_t type_du; // 2 * cell size -#else -typedef unsigned char type_c; // 1 byte -typedef short type_w; // 2 bytes -typedef int type_l; // 4 bytes -typedef long type_n; // cell size -typedef unsigned long type_u; // cell size -typedef long long type_d; // 2 * cell size -typedef unsigned long long type_du;// 2 * cell size -#endif - -#define CELLSIZE (sizeof(type_u) / sizeof(type_c)) - -typedef union cell { - type_n n; - type_u u; - void *a; - type_c c[CELLSIZE]; - type_w w[CELLSIZE/2]; - type_l l[CELLSIZE/4]; -} cell; diff -urN paflof/unix.code paflof-stepan/unix.code --- paflof/unix.code 1970-01-01 01:00:00.000000000 +0100 +++ paflof-stepan/unix.code 2002-06-23 12:13:58.000000000 +0200 @@ -0,0 +1,63 @@ +/* Unix host system hooks. */ + +#ifdef DEBUG_STACKS +#define NEXT00 do { \ + debug_stacks(); \ + cf = cfa->a; \ + goto *cf; \ +} while (0) +#else +#define NEXT00 do { \ + cf = cfa->a; \ + goto *cf; \ +} while (0) +#endif + +#define NEXT0 do { \ + cfa = ip->a; \ + NEXT00; \ +} while (0) + +#define NEXT do { \ + ip++; \ + NEXT0; \ +} while (0) + + +code_BYE: + { + return; + } +code_UNIX_X2d_KEY: + { + (++dp)->n = fgetc(stdin); + NEXT; + } +code_UNIX_X2d_EMIT: + { + fputc((dp--)->u, stdout) ; + NEXT; + } +code_UNIX_X2d_MAP_X2d_FILE: + { + char name[256]; + int fd; + int length; + void *map; + memcpy(name, (dp - 1)->a, dp->u); + name[dp->u] = 0; + fd = open(name, O_RDONLY); + length = lseek(fd, 0, SEEK_END); + map = mmap(0, length, PROT_READ, MAP_SHARED, fd, 0); + close(fd); + (dp - 1)->a = map; + dp->u = length; + NEXT; + } +code_UNIX_X2d_UNMAP_X2d_FILE: + { + munmap((dp - 1)->a, dp->u); + dp -= 2; + NEXT; + } + diff -urN paflof/unix.in paflof-stepan/unix.in --- paflof/unix.in 1970-01-01 01:00:00.000000000 +0100 +++ paflof-stepan/unix.in 2002-06-23 12:14:14.000000000 +0200 @@ -0,0 +1,6 @@ +/* Unix host system hooks. */ +cod(BYE) +cod(UNIX-KEY) +cod(UNIX-EMIT) +cod(UNIX-MAP-FILE) +cod(UNIX-UNMAP-FILE)