[OpenBIOS] Paflof update
Stefan Reinauer
stepan at suse.de
Sun Jun 23 13:45:35 CEST 2002
Hi,
some updates on paflof I made recently:
* use c style comments to not break non gcc compilers (compile
with -ansi -pedantic)
* implement unaligned-w@, unaligned-w!, unaligned-l@, unaligned-l!
* implement 2constant
* fix typo in dict.source
* use conf.pl to create types.h according to compiler capabilities
(cross compiling possible) (cleaner version then last patch)
* move unix host code from prim.code to unix.code
Best regards,
Stefan Reinauer
--
The x86 isn't all that complex - it just doesn't make a lot of
sense. -- Mike Johnson, Leader of 80x86 Design at AMD
Microprocessor Report (1994)
-------------- next part --------------
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 (<F>) {
+ 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 <stdint.h>\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 <stdio.h>
#include <stdlib.h>
+/* #include <unistd.h> */
+#ifdef ANSI
+#define __USE_XOPEN_EXTENDED
+#define __USE_MISC
+#define __USE_POSIX
+#define __USE_POSIX199309
+#endif
#include <unistd.h>
-#include <string.h>
#include <sys/mman.h>
+#include <string.h>
#include <termios.h>
#include <signal.h>
#include <fcntl.h>
#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 <stdint.h>
-
-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)
More information about the openbios
mailing list