| char *progname = "gforth"; |
char *progname = "gforth"; |
| int optind = 1; |
int optind = 1; |
| #endif |
#endif |
| |
#ifdef HAS_DEBUG |
| static int debug=0; |
static int debug=0; |
| |
#endif |
| ImageHeader *gforth_header; |
ImageHeader *gforth_header; |
| |
|
| |
#ifdef MEMCMP_AS_SUBROUTINE |
| |
int gforth_memcmp(const char * s1, const char * s2, size_t n) |
| |
{ |
| |
return memcmp(s1, s2, n); |
| |
} |
| |
#endif |
| |
|
| /* image file format: |
/* image file format: |
| * "#! binary-path -i\n" (e.g., "#! /usr/local/bin/gforth-0.4.0 -i\n") |
* "#! binary-path -i\n" (e.g., "#! /usr/local/bin/gforth-0.4.0 -i\n") |
| * padding to a multiple of 8 |
* padding to a multiple of 8 |
| Address r; |
Address r; |
| /* leave a little room (64B) for stack underflows */ |
/* leave a little room (64B) for stack underflows */ |
| if ((r = malloc(size+64))==NULL) { |
if ((r = malloc(size+64))==NULL) { |
| |
#ifdef HAS_DEBUG |
| perror(progname); |
perror(progname); |
| |
#endif |
| exit(1); |
exit(1); |
| } |
} |
| r = (Address)((((Cell)r)+(sizeof(Float)-1))&(-sizeof(Float))); |
r = (Address)((((Cell)r)+(sizeof(Float)-1))&(-sizeof(Float))); |
| |
#ifdef HAS_DEBUG |
| if (debug) |
if (debug) |
| fprintf(stderr, "malloc succeeds, address=$%lx\n", (long)r); |
fprintf(stderr, "malloc succeeds, address=$%lx\n", (long)r); |
| |
#endif |
| return r; |
return r; |
| } |
} |
| |
|
| Address r; |
Address r; |
| |
|
| #if defined(MAP_ANON) |
#if defined(MAP_ANON) |
| |
#ifdef HAS_DEBUG |
| if (debug) |
if (debug) |
| fprintf(stderr,"try mmap($%lx, $%lx, ..., MAP_ANON, ...); ", (long)next_address, (long)size); |
fprintf(stderr,"try mmap($%lx, $%lx, ..., MAP_ANON, ...); ", (long)next_address, (long)size); |
| |
#endif |
| r=mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_ANON|MAP_PRIVATE, -1, 0); |
r=mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_ANON|MAP_PRIVATE, -1, 0); |
| #else /* !defined(MAP_ANON) */ |
#else /* !defined(MAP_ANON) */ |
| /* Ultrix (at least) does not define MAP_FILE and MAP_PRIVATE (both are |
/* Ultrix (at least) does not define MAP_FILE and MAP_PRIVATE (both are |
| dev_zero = open("/dev/zero", O_RDONLY); |
dev_zero = open("/dev/zero", O_RDONLY); |
| if (dev_zero == -1) { |
if (dev_zero == -1) { |
| r = (Address)-1; |
r = (Address)-1; |
| |
#ifdef HAS_DEBUG |
| if (debug) |
if (debug) |
| fprintf(stderr, "open(\"/dev/zero\"...) failed (%s), no mmap; ", |
fprintf(stderr, "open(\"/dev/zero\"...) failed (%s), no mmap; ", |
| strerror(errno)); |
strerror(errno)); |
| |
#endif |
| } else { |
} else { |
| |
#ifdef HAS_DEBUG |
| if (debug) |
if (debug) |
| fprintf(stderr,"try mmap($%lx, $%lx, ..., MAP_FILE, dev_zero, ...); ", (long)next_address, (long)size); |
fprintf(stderr,"try mmap($%lx, $%lx, ..., MAP_FILE, dev_zero, ...); ", (long)next_address, (long)size); |
| |
#endif |
| r=mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FILE|MAP_PRIVATE, dev_zero, 0); |
r=mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FILE|MAP_PRIVATE, dev_zero, 0); |
| } |
} |
| #endif /* !defined(MAP_ANON) */ |
#endif /* !defined(MAP_ANON) */ |
| |
|
| if (r != (Address)-1) { |
if (r != (Address)-1) { |
| |
#ifdef HAS_DEBUG |
| if (debug) |
if (debug) |
| fprintf(stderr, "success, address=$%lx\n", (long) r); |
fprintf(stderr, "success, address=$%lx\n", (long) r); |
| |
#endif |
| if (pagesize != 1) |
if (pagesize != 1) |
| next_address = (Address)(((((Cell)r)+size-1)&-pagesize)+2*pagesize); /* leave one page unmapped */ |
next_address = (Address)(((((Cell)r)+size-1)&-pagesize)+2*pagesize); /* leave one page unmapped */ |
| return r; |
return r; |
| } |
} |
| |
#ifdef HAS_DEBUG |
| if (debug) |
if (debug) |
| fprintf(stderr, "failed: %s\n", strerror(errno)); |
fprintf(stderr, "failed: %s\n", strerror(errno)); |
| |
#endif |
| #endif /* HAVE_MMAP */ |
#endif /* HAVE_MMAP */ |
| /* use malloc as fallback */ |
/* use malloc as fallback */ |
| return verbose_malloc(size); |
return verbose_malloc(size); |
| for(;stack>0;stack--) |
for(;stack>0;stack--) |
| *--sp0=entries[stack-1]; |
*--sp0=entries[stack-1]; |
| |
|
| |
#ifdef SYSSIGNALS |
| get_winsize(); |
get_winsize(); |
| |
|
| #ifdef SYSSIGNALS |
|
| install_signal_handlers(); /* right place? */ |
install_signal_handlers(); /* right place? */ |
| |
|
| if ((throw_code=setjmp(throw_jmp_buf))) { |
if ((throw_code=setjmp(throw_jmp_buf))) { |
| } |
} |
| |
|
| |
|
| |
#ifndef INCLUDE_IMAGE |
| void print_sizes(Cell sizebyte) |
void print_sizes(Cell sizebyte) |
| /* print size information */ |
/* print size information */ |
| { |
{ |
| 1 << ((sizebyte >> 5) & 3)); |
1 << ((sizebyte >> 5) & 3)); |
| } |
} |
| |
|
| #ifndef INCLUDE_IMAGE |
|
| Address loader(FILE *imagefile, char* filename) |
Address loader(FILE *imagefile, char* filename) |
| /* returns the address of the image proper (after the preamble) */ |
/* returns the address of the image proper (after the preamble) */ |
| { |
{ |
| preamblesize+=8; |
preamblesize+=8; |
| } while(memcmp(magic,"Gforth2",7)); |
} while(memcmp(magic,"Gforth2",7)); |
| magic7 = magic[7]; |
magic7 = magic[7]; |
| |
#ifdef HAS_DEBUG |
| if (debug) { |
if (debug) { |
| magic[7]='\0'; |
magic[7]='\0'; |
| fprintf(stderr,"Magic found: %s ", magic); |
fprintf(stderr,"Magic found: %s ", magic); |
| print_sizes(magic7); |
print_sizes(magic7); |
| } |
} |
| |
#endif |
| |
|
| if (magic7 != sizebyte) |
if (magic7 != sizebyte) |
| { |
{ |
| #elif PAGESIZE |
#elif PAGESIZE |
| pagesize=PAGESIZE; /* in limits.h according to Gallmeister's POSIX.4 book */ |
pagesize=PAGESIZE; /* in limits.h according to Gallmeister's POSIX.4 book */ |
| #endif |
#endif |
| |
#ifdef HAS_DEBUG |
| if (debug) |
if (debug) |
| fprintf(stderr,"pagesize=%ld\n",(unsigned long) pagesize); |
fprintf(stderr,"pagesize=%ld\n",(unsigned long) pagesize); |
| |
#endif |
| |
|
| image = dict_alloc(preamblesize+dictsize+data_offset)+data_offset; |
image = dict_alloc(preamblesize+dictsize+data_offset)+data_offset; |
| rewind(imagefile); /* fseek(imagefile,0L,SEEK_SET); */ |
rewind(imagefile); /* fseek(imagefile,0L,SEEK_SET); */ |
| char * expfilename = tilde_cstr(fullfilename, strlen(fullfilename), 1); |
char * expfilename = tilde_cstr(fullfilename, strlen(fullfilename), 1); |
| |
|
| image_file=fopen(expfilename,"rb"); |
image_file=fopen(expfilename,"rb"); |
| |
#ifdef HAS_DEBUG |
| if (image_file!=NULL && debug) |
if (image_file!=NULL && debug) |
| fprintf(stderr, "Opened image file: %s\n", expfilename); |
fprintf(stderr, "Opened image file: %s\n", expfilename); |
| |
#endif |
| return image_file; |
return image_file; |
| } |
} |
| |
|
| |
|
| int main(int argc, char **argv, char **env) |
int main(int argc, char **argv, char **env) |
| { |
{ |
| |
#ifdef HAS_OS |
| char *path = getenv("GFORTHPATH") ? : DEFAULTPATH; |
char *path = getenv("GFORTHPATH") ? : DEFAULTPATH; |
| |
#else |
| |
char *path = DEFAULTPATH; |
| |
#endif |
| #ifndef INCLUDE_IMAGE |
#ifndef INCLUDE_IMAGE |
| char *imagename="gforth.fi"; |
char *imagename="gforth.fi"; |
| FILE *image_file; |
FILE *image_file; |