Commit f24ee303 authored by anton's avatar anton

cleaned up NEXT macros; provided for CISC (united) and RISC (split) versions

cstr is now a function that can process arbitrarily long strings
parent e07dd991
/*
$Id: 386.h,v 1.2 1994-05-18 17:32:59 pazsan Exp $
$Id: 386.h,v 1.3 1994-09-08 17:20:03 anton Exp $
Copyright 1992 by the ANSI figForth Development Group
This is the machine-specific part for Intel 386 compatible processors
......@@ -26,6 +26,10 @@ typedef float SFloat;
/* define this if the least-significant byte is at the largets address */
/* #define BIG_ENDIAN */
/* define this if the processor cannot exploit instruction-level
parallelism and/or has few registers */
#define CISC_NEXT
#ifdef DIRECT_THREADED
/* PFA gives the parameter field address corresponding to a cfa */
#define PFA(cfa) (((Cell *)cfa)+2)
......@@ -55,6 +59,3 @@ typedef float SFloat;
#endif
#define rint(x) floor((x)+0.5)
/*
#define CISC_NEXT
*/
......@@ -5,9 +5,9 @@ GCC = gcc
FORTH = gforth
CC = gcc
SWITCHES = \
-fno-defer-pop -fcaller-saves \
-D_POSIX_VERSION -DUSE_TOS -DUSE_FTOS -DDEFAULTBIN='"'`pwd`'"' \
#-DDIRECT_THREADED #-DNDEBUG #turn off assertions
-fno-defer-pop -fcaller-saves -m486 \
-D_POSIX_VERSION -DUSE_FTOS \
#-DDIRECT_THREADED #-DFORCE_REG #-DNDEBUG #turn off assertions
CFLAGS = -O4 -Wall -g $(SWITCHES)
#-Xlinker -n puts text and data into the same 256M region
......
/*
$Id: engine.c,v 1.13 1994-08-31 19:42:44 pazsan Exp $
$Id: engine.c,v 1.14 1994-09-08 17:20:05 anton Exp $
Copyright 1992 by the ANSI figForth Development Group
*/
......@@ -41,29 +41,34 @@ typedef struct F83Name {
#define F83NAME_SMUDGE(np) (((np)->countetc & 0x40) != 0)
#define F83NAME_IMMEDIATE(np) (((np)->countetc & 0x20) != 0)
/* NEXT and NEXT1 are split into several parts to help scheduling */
/* NEXT and NEXT1 are split into several parts to help scheduling,
unless CISC_NEXT is defined */
#ifdef CISC_NEXT
#define NEXT1_P1
#define NEXT_P1
#define DEF_CA
#ifdef DIRECT_THREADED
# define NEXT1_P1
# ifdef i386
# define NEXT1_P2 ({cfa=*ip++; goto *cfa;})
# else
# define NEXT1_P2 ({goto *cfa;})
# endif
# define DEF_CA
#define NEXT1_P2 ({goto *cfa;})
#else
# define NEXT1_P1 ({ca = *cfa;})
# define NEXT1_P2 ({goto *ca;})
# define DEF_CA Label ca;
#endif
#if defined(i386) && defined(DIRECT_THREADED)
# define NEXT_P1
# define NEXT1 ({goto *cfa;})
#else
# define NEXT_P1 ({cfa = *ip++; NEXT1_P1;})
# define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;})
#endif
#define NEXT1_P2 ({goto **cfa;})
#endif /* DIRECT_THREADED */
#define NEXT_P2 ({cfa = *ip++; NEXT1_P2;})
#else /* CISC_NEXT */
#ifdef DIRECT_THREADED
#define NEXT1_P1
#define NEXT1_P2 ({goto *cfa;})
#define DEF_CA
#else /* DIRECT_THREADED */
#define NEXT1_P1 ({ca = *cfa;})
#define NEXT1_P2 ({goto *ca;})
#define DEF_CA Label ca;
#endif /* DIRECT_THREADED */
#define NEXT_P1 ({cfa=*ip++; NEXT1_P1;})
#define NEXT_P2 NEXT1_P2
#endif /* CISC_NEXT */
#define NEXT ({DEF_CA NEXT_P1; NEXT1_P2;})
#define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;})
#define NEXT ({DEF_CA NEXT_P1; NEXT_P2;})
#ifdef USE_TOS
#define IF_TOS(x) x
......@@ -82,28 +87,34 @@ typedef struct F83Name {
int emitcounter;
#define NULLC '\0'
#ifdef copycstr
# define cstr(to,from,size)\
{ memcpy(to,from,size);\
to[size]=NULLC;}
#else
char scratch[1024];
int soffset;
# define cstr(from,size) \
({ char * to = scratch; \
memcpy(to,from,size); \
to[size] = NULLC; \
soffset = size+1; \
to; \
})
# define cstr1(from,size) \
({ char * to = scratch+soffset; \
memcpy(to,from,size); \
to[size] = NULLC; \
soffset += size+1; \
to; \
})
#endif
char *cstr(Char *from, UCell size, int clear)
/* if clear is true, scratch can be reused, otherwise we want more of
the same */
{
static char *scratch=NULL;
static unsigned scratchsize=0;
static char *nextscratch;
char *oldnextscratch;
if (clear)
nextscratch=scratch;
if (scratch==NULL) {
scratch=malloc(size+1);
nextscratch=scratch;
scratchsize=size;
}
else if (nextscratch+size>scratch+scratchsize) {
char *oldscratch=scratch;
scratch = realloc(scratch, (nextscratch-scratch)+size+1);
nextscratch=scratch+(nextscratch-oldscratch);
scratchsize=size;
}
memcpy(nextscratch,from,size);
nextscratch[size]='\0';
oldnextscratch = nextscratch;
nextscratch += size+1;
return oldnextscratch;
}
#define NEWLINE '\n'
......
\ Parameter for target systems 06oct92py
4 Constant cell
2 Constant cell<<
5 Constant cell>bit
8 Constant bits/byte
8 Constant float
true Constant endian
( true=big, false=little )
\ Parameter for target systems 06oct92py
4 Constant cell
2 Constant cell<<
5 Constant cell>bit
8 Constant bits/byte
8 Constant float
false Constant endian
( true=big, false=little )
/*
$Id: main.c,v 1.10 1994-09-05 17:36:22 anton Exp $
$Id: main.c,v 1.11 1994-09-08 17:20:09 anton Exp $
Copyright 1993 by the ANSI figForth Development Group
*/
......@@ -16,10 +16,6 @@
#include "io.h"
#include "getopt.h"
#ifndef DEFAULTBIN
# define DEFAULTBIN ""
#endif
#ifndef DEFAULTPATH
# define DEFAULTPATH "/usr/local/lib/gforth:."
#endif
......
......@@ -608,15 +608,15 @@ deprep_terminal();
return (Label *)n;
system c_addr u -- n own
n=system(cstr(c_addr,u));
n=system(cstr(c_addr,u,1));
getenv c_addr1 u1 -- c_addr2 u2 new
c_addr2 = getenv(cstr(c_addr1,u1));
c_addr2 = getenv(cstr(c_addr1,u1,1));
u2=strlen(c_addr2);
popen c_addr u n -- wfileid own
static char* mode[2]={"r","w"};
wfileid=(Cell)popen(cstr(c_addr,u),mode[n]);
wfileid=(Cell)popen(cstr(c_addr,u,1),mode[n]);
pclose wfileid -- wior own
wior=pclose((FILE *)wfileid);
......@@ -713,12 +713,12 @@ close-file wfileid -- wior file close_file
wior = FILEIO(fclose((FILE *)wfileid)==EOF);
open-file c_addr u ntype -- w2 wior file open_file
w2 = (Cell)fopen(cstr(c_addr, u), fileattr[ntype]);
w2 = (Cell)fopen(cstr(c_addr, u,1), fileattr[ntype]);
wior = FILEEXIST(w2 == NULL);
create-file c_addr u ntype -- w2 wior file create_file
int fd;
fd = creat(cstr(c_addr, u), 0644);
fd = creat(cstr(c_addr, u,1), 0644);
if (fd > -1) {
w2 = (Cell)fdopen(fd, fileattr[ntype]);
assert(w2 != NULL);
......@@ -730,10 +730,11 @@ if (fd > -1) {
}
delete-file c_addr u -- wior file delete_file
wior = FILEEXIST(unlink(cstr(c_addr, u)));
wior = FILEEXIST(unlink(cstr(c_addr, u,1)));
rename-file c_addr1 u1 c_addr2 u2 -- wior file-ext rename_file
wior = FILEEXIST(rename(cstr1(c_addr1, u1), cstr(c_addr2, u2)));
char *s1=cstr(c_addr2, u2,1);
wior = FILEEXIST(rename(cstr(c_addr1, u1, 0), s1));
file-position wfileid -- ud wior file file_position
/* !! use tell and lseek? */
......@@ -905,7 +906,7 @@ memmove(c_addr,sig,u);
>float c_addr u -- flag float to_float
/* real signature: c_addr u -- r t / f */
Float r;
char *number=cstr(c_addr, u);
char *number=cstr(c_addr, u, 1);
char *endconv;
r=strtod(number,&endconv);
if((flag=FLAG(!(int)*endconv)))
......
......@@ -15,7 +15,6 @@
\ 5) Words that call NEXT themselves have to be done very carefully.
\
\ To do:
\ add the store optimization for doubles
\ regarding problem 1 above: It would be better (for over) to implement
\ the alternative
......@@ -524,7 +523,7 @@ set-current
." NEXT_P1;" cr
stores
fill-tos
." NEXT1_P2;" cr
." NEXT_P2;" cr
." }" cr
cr
;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment