Commit 6a8f8e68 authored by pazsan's avatar pazsan

* Made slight modification in configure

* Select from make first and make more to allow first time compilation
* Added simple image dump and reload
* Added extended COLD functionality in 'COLD for image reboot
* Added boot procedures in hash.fs and history.fs
parent 9a4b2e1b
......@@ -4,16 +4,16 @@ RM = echo 'Trying to remove'
GCC = gcc
FORTH = gforth
CC = gcc
MAKE = gmake
XCFLAGS =
XDEFINES =
SWITCHES = $(XCFLAGS) $(XDEFINES) -DDEFAULTBIN='"'`pwd`'"' \
#-DNDEBUG #turn off assertions
CFLAGS = -O4 -Wall -g $(SWITCHES)
SWITCHES = $(XCFLAGS) $(XDEFINES) -DDEFAULTBIN='"'`pwd`'"' #-DNDEBUG #turn off assertions
CFLAGS = -O4 -Wall $(SWITCHES)
#-Xlinker -n puts text and data into the same 256M region
#John Wavrik should use -Xlinker -N to get a writable text (executable)
LDFLAGS = -Xlinker -N
LDLIBS = -lm
LDLIBS = -lm
EMACS = emacs
......@@ -40,10 +40,16 @@ OBJECTS = engine.o io.o main.o
# things that need a working forth system to be generated
# this is used for antidependences,
FORTH_GEN = primitives.i prim_labels.i \
FORTH_GEN = primitives.i prim_labels.i aliases.fs \
kernl32l.fi kernl32b.fi gforth.texi
all: gforth
all:
if [ ! -x gforth ]; then $(MAKE) first; fi
$(MAKE) more
first: gforth
more: gforth $(FORTH_GEN)
#from the gcc Makefile:
#"Deletion of files made during compilation.
......@@ -69,7 +75,7 @@ realclean: distclean
#gforth.tar.gz: $(SOURCES) $(GEN_PRECIOUS) CVS
# cd ..; tar cvf gforth/gforth.tar gforth/{$^}; gzip -9 gforth/gforth.tar
gforth: $(OBJECTS) $(FORTH_GEN)
gforth: $(OBJECTS)
-cp gforth gforth~
$(GCC) $(LDFLAGS) $(OBJECTS) $(LDLIBS) -o $@
......
......@@ -84,6 +84,7 @@ host=
build=
name1=
name2=
debugging=-g
for arg in $*;
do
......@@ -171,7 +172,11 @@ do
| --direct-thre | --direct-thr | --direct-th | --direct-t | --direct- \
| --direct | --direc | --dire | --dir | --di | --d)
threading=-DDIRECT_THREADED
;;
;;
-without-debug | --without-debu | --without-deb | --without-de \
| --without-d)
debugging=
;;
-with-* | --with-*) ;; #ignored
-without-* | --without-*) ;; #ignored
-enable-* | --enable-*) ;; #ignored
......@@ -387,9 +392,11 @@ else
ln -s kernl32l.fi gforth.fi
fi
sed -e "s|^XCFLAGS[ ]*=*\(.*\)$|XCFLAGS = \1 $flags|" \
-e "s|^XDEFINES[ ]*=*\(.*\)$|XDEFINES = \1 $defines|" \
-e "s|^OBJECTS[ ]*=*\(.*\)$|OBJECTS = \1 $extra_obs|" \
sed -e "s|^XCFLAGS[ ]*=*\(.*\)$|XCFLAGS = \1 $flags|" \
-e "s|^XDEFINES[ ]*=*\(.*\)$|XDEFINES = \1 $defines|" \
-e "s|^OBJECTS[ ]*=*\(.*\)$|OBJECTS = \1 $extra_obs|" \
-e "s|^CFLAGS[ ]*=*\(.*\)$|CFLAGS = $debugging\1|" \
-e "s|^LDFLAGS[ ]*=*\(.*\)$|LDFLAGS = $debugging\1|" \
Makefile.in > Makefile
exit 0
......
\ CROSS.FS The Cross-Compiler 06oct92py
\ $Id: cross.fs,v 1.14 1994-10-24 19:15:53 anton Exp $
\ $Id: cross.fs,v 1.15 1994-11-15 15:55:34 pazsan Exp $
\ Idea and implementation: Bernd Paysan (py)
\ Copyright 1992 by the ANSI figForth Development Group
\ Copyright 1992-94 by the GNU Forth Development Group
\ Log:
\ changed in ; [ to state off 12may93jaw
......
\ image dump 15nov94py
: dump-fi ( addr u -- ) w/o open-file throw >r
forthstart here over - dup forthstart cell+ !
r@ write-file throw
relinfo here forthstart - 1- 8 cells / 1+ r@ write-file throw
r> close-file throw ;
......@@ -91,6 +91,11 @@ Create hashsearch ' hash-find A, ' hash-reveal A, ' (rehash) A,
addall \ Baum aufbauen
\ Baumsuche ist installiert.
: hash-cold ( -- ) Defers 'cold
HashPointer off HashTable off HashIndex off
addall ;
' hash-cold IS 'cold
: .words ( -- )
base @ >r hex HashTable @ Hashlen 0
DO cr i 2 .r ." : " dup i cells +
......
\ History file support 16oct94py
0 Value history
2Variable forward^
2Variable backward^
2Variable end^
: get-history ( addr len -- wid )
2dup r/w open-file 0<
IF drop r/w create-file throw ELSE nip nip THEN
to history
history file-size throw
2dup forward^ 2! 2dup backward^ 2! end^ 2! ;
s" gforth.history" get-history
\ moving in history file 16oct94py
: clear-line ( max span addr pos1 -- max addr )
backspaces over spaces swap backspaces ;
: clear-tib ( max span addr pos -- max 0 addr 0 false )
clear-line 0 tuck dup ;
: get-line ( max addr -- max span addr pos dpos )
history file-position throw backward^ 2!
2dup swap history read-line throw drop
2dup type tuck
history file-position throw forward^ 2! ;
: next-line ( max span addr pos1 -- max span addr pos2 false )
clear-line
forward^ 2@ history reposition-file throw
get-line 0 ;
: prev-line ( max span addr pos1 -- max span addr pos2 false )
clear-line over 2 + negate s>d backward^ 2@ d+ 0. dmax
2dup history reposition-file throw
BEGIN 2over swap history read-line throw WHILE
>r history file-position throw
2dup backward^ 2@ d< WHILE 2swap 2drop rdrop
REPEAT ELSE >r history file-position throw THEN
forward^ 2! backward^ 2! r> tuck 2dup type 0 ;
: ctrl ( "<char>" -- ctrl-code )
char [char] @ - postpone Literal ; immediate
Create lfpad #lf c,
: (enter) ( max span addr pos1 -- max span addr pos2 true )
>r end^ 2@ history reposition-file throw
2dup swap history write-file throw
lfpad 1 history write-file throw
history file-position throw 2dup backward^ 2! end^ 2!
r> (ret) ;
\ some other key commands 16oct94py
: first-pos ( max span addr pos1 -- max span addr 0 0 )
backspaces 0 0 ;
: end-pos ( max span addr pos1 -- max span addr span 0 )
type-rest 2drop over 0 ;
: extract-word ( addr len -- addr' len' ) dup >r
BEGIN 1- dup 0>= WHILE 2dup + c@ bl = UNTIL THEN 1+
tuck + r> rot - ;
Create prefix-found 0 , 0 ,
: word-lex ( nfa1 nfa2 -- -1/0/1 )
dup 0= IF 2drop 1 EXIT THEN
cell+ >r cell+ count $1F and
dup r@ c@ $1F and =
IF r> char+ capscomp 0<= EXIT THEN
nip r> c@ $1F and < ;
: search-prefix ( addr len1 -- suffix len2 ) 0 >r context
BEGIN BEGIN dup @ over cell - @ = WHILE cell - REPEAT
dup >r -rot r> @ @
BEGIN dup WHILE >r dup r@ cell+ c@ $1F and <=
IF 2dup r@ cell+ char+ capscomp 0=
IF r> dup r@ word-lex
IF dup prefix-found @ word-lex
0>= IF rdrop dup >r THEN
THEN >r
THEN
THEN r> @
REPEAT drop rot cell - dup vp u> 0=
UNTIL drop r> dup prefix-found ! ?dup
IF cell+ count $1F and rot /string rot drop
ELSE 2drop s" " THEN ;
: tab-expand ( max span addr pos1 -- max span addr pos2 0 )
prefix-found cell+ @ 0 ?DO (del) LOOP
2dup extract-word search-prefix
dup prefix-found @ 0<> - prefix-found cell+ !
bounds ?DO I c@ (ins) LOOP
prefix-found @ IF bl (ins) THEN 0 ;
: kill-prefix ( key -- key )
dup #tab <> IF 0 0 prefix-found 2! THEN ;
' kill-prefix IS everychar
' next-line ctrl N cells ctrlkeys + !
' prev-line ctrl P cells ctrlkeys + !
' clear-tib ctrl K cells ctrlkeys + !
' first-pos ctrl A cells ctrlkeys + !
' end-pos ctrl E cells ctrlkeys + !
' (enter) #lf cells ctrlkeys + !
' (enter) #cr cells ctrlkeys + !
' tab-expand #tab cells ctrlkeys + !
\ History file support 16oct94py
0 Value history
2Variable forward^
2Variable backward^
2Variable end^
: get-history ( addr len -- wid )
2dup r/w open-file 0<
IF drop r/w create-file throw ELSE nip nip THEN
to history
history file-size throw
2dup forward^ 2! 2dup backward^ 2! end^ 2! ;
s" gforth.history" get-history
: history-cold Defers 'cold
s" gforth.history" get-history ;
' history-cold IS 'cold
\ moving in history file 16oct94py
: clear-line ( max span addr pos1 -- max addr )
backspaces over spaces swap backspaces ;
: clear-tib ( max span addr pos -- max 0 addr 0 false )
clear-line 0 tuck dup ;
: get-line ( max addr -- max span addr pos dpos )
history file-position throw backward^ 2!
2dup swap history read-line throw drop
2dup type tuck
history file-position throw forward^ 2! ;
: next-line ( max span addr pos1 -- max span addr pos2 false )
clear-line
forward^ 2@ history reposition-file throw
get-line 0 ;
: prev-line ( max span addr pos1 -- max span addr pos2 false )
clear-line over 2 + negate s>d backward^ 2@ d+ 0. dmax
2dup history reposition-file throw
BEGIN 2over swap history read-line throw WHILE
>r history file-position throw
2dup backward^ 2@ d< WHILE 2swap 2drop rdrop
REPEAT ELSE >r history file-position throw THEN
forward^ 2! backward^ 2! r> tuck 2dup type 0 ;
: ctrl ( "<char>" -- ctrl-code )
char [char] @ - postpone Literal ; immediate
Create lfpad #lf c,
: (enter) ( max span addr pos1 -- max span addr pos2 true )
>r end^ 2@ history reposition-file throw
2dup swap history write-file throw
lfpad 1 history write-file throw
history file-position throw 2dup backward^ 2! end^ 2!
r> (ret) ;
\ some other key commands 16oct94py
: first-pos ( max span addr pos1 -- max span addr 0 0 )
backspaces 0 0 ;
: end-pos ( max span addr pos1 -- max span addr span 0 )
type-rest 2drop over 0 ;
: extract-word ( addr len -- addr' len' ) dup >r
BEGIN 1- dup 0>= WHILE 2dup + c@ bl = UNTIL THEN 1+
tuck + r> rot - ;
Create prefix-found 0 , 0 ,
: word-lex ( nfa1 nfa2 -- -1/0/1 )
dup 0= IF 2drop 1 EXIT THEN
cell+ >r cell+ count $1F and
dup r@ c@ $1F and =
IF r> char+ capscomp 0<= EXIT THEN
nip r> c@ $1F and < ;
: search-prefix ( addr len1 -- suffix len2 ) 0 >r context
BEGIN BEGIN dup @ over cell - @ = WHILE cell - REPEAT
dup >r -rot r> @ @
BEGIN dup WHILE >r dup r@ cell+ c@ $1F and <=
IF 2dup r@ cell+ char+ capscomp 0=
IF r> dup r@ word-lex
IF dup prefix-found @ word-lex
0>= IF rdrop dup >r THEN
THEN >r
THEN
THEN r> @
REPEAT drop rot cell - dup vp u> 0=
UNTIL drop r> dup prefix-found ! ?dup
IF cell+ count $1F and rot /string rot drop
ELSE 2drop s" " THEN ;
: tab-expand ( max span addr pos1 -- max span addr pos2 0 )
prefix-found cell+ @ 0 ?DO (del) LOOP
2dup extract-word search-prefix
dup prefix-found @ 0<> - prefix-found cell+ !
bounds ?DO I c@ (ins) LOOP
prefix-found @ IF bl (ins) THEN 0 ;
: kill-prefix ( key -- key )
dup #tab <> IF 0 0 prefix-found 2! THEN ;
' kill-prefix IS everychar
' next-line ctrl N cells ctrlkeys + !
' prev-line ctrl P cells ctrlkeys + !
' clear-tib ctrl K cells ctrlkeys + !
' first-pos ctrl A cells ctrlkeys + !
' end-pos ctrl E cells ctrlkeys + !
' (enter) #lf cells ctrlkeys + !
' (enter) #cr cells ctrlkeys + !
' tab-expand #tab cells ctrlkeys + !
\ KERNAL.FS ANS figFORTH kernal 17dec92py
\ KERNAL.FS GNU FORTH kernal 17dec92py
\ $ID:
\ Idea and implementation: Bernd Paysan (py)
\ Copyright 1992 by the ANSI figForth Development Group
......@@ -1404,7 +1404,10 @@ Variable argc
THEN
+LOOP ;
Defer 'cold ' noop IS 'cold
: cold ( -- )
'cold
pathstring 2@ process-path pathdirs 2!
argc @ 1 >
IF
......
/*
$Id: main.c,v 1.15 1994-10-24 19:16:02 anton Exp $
$Id: main.c,v 1.16 1994-11-15 15:55:40 pazsan Exp $
Copyright 1993 by the ANSI figForth Development Group
*/
......@@ -17,20 +17,20 @@
#ifdef USE_GETOPT
# include "getopt.h"
#else
extern int getopt (int argc, char *argv[], char *optstring);
extern int getopt (int , char * const [], const char *);
extern char *optarg;
extern int optind, opterr;
extern char *optarg;
extern int optind, opterr;
#endif
#ifndef DEFAULTPATH
# define DEFAULTPATH "/usr/local/lib/gforth:."
# define DEFAULTPATH "/usr/local/lib/gforth:."
#endif
#ifdef DIRECT_THREADED
# define CA(n) (symbols[(n)])
# define CA(n) (symbols[(n)])
#else
# define CA(n) ((int)(symbols+(n)))
# define CA(n) ((int)(symbols+(n)))
#endif
#define maxaligned(n) ((((Cell)n)+sizeof(Float)-1)&-sizeof(Float))
......@@ -49,6 +49,7 @@ char *progname;
* size of data and FP stack (in bytes)
* pointer to start of code
* pointer into throw (for signal handling)
* pointer to dictionary
* data (size in image[1])
* tags (1 bit/data cell)
*
......@@ -64,73 +65,79 @@ char *progname;
void relocate(Cell *image, char *bitstring, int size, Label symbols[])
{
int i=0, j, k, steps=(size/sizeof(Cell))/8;
char bits;
int i=0, j, k, steps=(size/sizeof(Cell))/8;
char bits;
/* static char bits[8]={0x80,0x40,0x20,0x10,0x08,0x04,0x02,0x01};*/
for(k=0; k<=steps; k++)
for(j=0, bits=bitstring[k]; j<8; j++, i++, bits<<=1)
if(bits & 0x80)
if(image[i]<0)
switch(image[i])
{
case CF_NIL : image[i]=0; break;
case CF(DOCOL) :
case CF(DOVAR) :
case CF(DOCON) :
case CF(DOUSER) :
case CF(DODEFER) : MAKE_CF(image+i,symbols[CF(image[i])]); break;
case CF(DODOES) : MAKE_DOES_CF(image+i,image[i+1]+((int)image));
break;
case CF(DOESJUMP): MAKE_DOES_HANDLER(image+i); break;
default : image[i]=(Cell)CA(CF(image[i]));
}
else
image[i]+=(Cell)image;
CACHE_FLUSH(image,size);
for(k=0; k<=steps; k++)
for(j=0, bits=bitstring[k]; j<8; j++, i++, bits<<=1)
if(bits & 0x80)
if(image[i]<0)
switch(image[i])
{
case CF_NIL : image[i]=0; break;
case CF(DOCOL) :
case CF(DOVAR) :
case CF(DOCON) :
case CF(DOUSER) :
case CF(DODEFER) : MAKE_CF(image+i,symbols[CF(image[i])]); break;
case CF(DODOES) : MAKE_DOES_CF(image+i,image[i+1]+((int)image));
break;
case CF(DOESJUMP): MAKE_DOES_HANDLER(image+i); break;
default : image[i]=(Cell)CA(CF(image[i]));
}
else
image[i]+=(Cell)image;
}
Cell *loader(FILE *imagefile)
{
Cell header[3];
Cell *image;
int wholesize;
int imagesize; /* everything needed by the image */
fread(header,1,3*sizeof(Cell),imagefile);
if (dictsize==0)
dictsize = header[0];
if (dsize==0)
dsize=header[2];
if (rsize==0)
rsize=header[2];
if (fsize==0)
fsize=header[2];
if (lsize==0)
lsize=header[2];
dictsize=maxaligned(dictsize);
dsize=maxaligned(dsize);
rsize=maxaligned(rsize);
lsize=maxaligned(lsize);
fsize=maxaligned(fsize);
wholesize = dictsize+dsize+rsize+fsize+lsize;
imagesize = header[1]+((header[1]-1)/sizeof(Cell))/8+1;
image=malloc(wholesize>imagesize?wholesize:imagesize);
memset(image,0,wholesize); /* why? - anton */
image[0]=header[0];
image[1]=header[1];
image[2]=header[2];
fread(image+3,1,header[1]-3*sizeof(Cell),imagefile);
fread(((void *)image)+header[1],1,((header[1]-1)/sizeof(Cell))/8+1,
imagefile);
fclose(imagefile);
relocate(image,(char *)image+header[1],header[1],engine(0,0,0,0,0));
Cell header[3];
Cell *image;
int wholesize;
int imagesize; /* everything needed by the image */
fread(header,1,3*sizeof(Cell),imagefile);
if (dictsize==0)
dictsize = header[0];
if (dsize==0)
dsize=header[2];
if (rsize==0)
rsize=header[2];
if (fsize==0)
fsize=header[2];
if (lsize==0)
lsize=header[2];
dictsize=maxaligned(dictsize);
dsize=maxaligned(dsize);
rsize=maxaligned(rsize);
lsize=maxaligned(lsize);
fsize=maxaligned(fsize);
wholesize = dictsize+dsize+rsize+fsize+lsize;
imagesize = header[1]+((header[1]-1)/sizeof(Cell))/8+1;
image=malloc(wholesize>imagesize?wholesize:imagesize);
memset(image,0,wholesize); /* why? - anton */
image[0]=header[0];
image[1]=header[1];
image[2]=header[2];
fread(image+3,1,header[1]-3*sizeof(Cell),imagefile);
fread(((void *)image)+header[1],1,((header[1]-1)/sizeof(Cell))/8+1,
imagefile);
fclose(imagefile);
if(image[5]==0) {
relocate(image,(char *)image+header[1],header[1],engine(0,0,0,0,0));
}
else if(image[5]!=(Cell)image) {
fprintf(stderr,"Corrupted image address, please recompile image\n");
exit(1);
}
return(image);
CACHE_FLUSH(image,image[1]);
return(image);
}
int go_forth(Cell *image, int stack, Cell *entries)
......@@ -188,10 +195,10 @@ int convsize(char *s, int elemsize)
int main(int argc, char **argv, char **env)
{
char *path, *path1;
char *imagename="gforth.fi";
FILE *image_file;
int c, retvalue;
char *path, *path1;
char *imagename="gforth.fi";
FILE *image_file;
int c, retvalue;
#if defined(i386) && defined(ALIGNMENT_CHECK) && !defined(DIRECT_THREADED)
/* turn on alignment checks on the 486.
......@@ -199,76 +206,80 @@ int main(int argc, char **argv, char **env)
__asm__("pushfl; popl %eax; orl $0x40000, %eax; pushl %eax; popfl;");
#endif
progname = argv[0];
if ((path=getenv("GFORTHPATH"))==NULL)
path = strcpy(malloc(strlen(DEFAULTPATH)+1),DEFAULTPATH);
opterr=0;
while (1) {
int option_index=0;
progname = argv[0];
if ((path=getenv("GFORTHPATH"))==NULL)
path = strcpy(malloc(strlen(DEFAULTPATH)+1),DEFAULTPATH);
opterr=0;
while (1) {
int option_index=0;
#ifdef USE_GETOPT
static struct option opts[] = {
{"image-file", required_argument, NULL, 'i'},
{"dictionary-size", required_argument, NULL, 'm'},
{"data-stack-size", required_argument, NULL, 'd'},
{"return-stack-size", required_argument, NULL, 'r'},
{"fp-stack-size", required_argument, NULL, 'f'},
{"locals-stack-size", required_argument, NULL, 'l'},
{"path", required_argument, NULL, 'p'},
{0,0,0,0}
/* no-init-file, no-rc? */
};
static struct option opts[] = {
{"image-file", required_argument, NULL, 'i'},
{"dictionary-size", required_argument, NULL, 'm'},
{"data-stack-size", required_argument, NULL, 'd'},
{"return-stack-size", required_argument, NULL, 'r'},
{"fp-stack-size", required_argument, NULL, 'f'},
{"locals-stack-size", required_argument, NULL, 'l'},
{"path", required_argument, NULL, 'p'},
{0,0,0,0}
/* no-init-file, no-rc? */
};
c = getopt_long(argc, argv, "+mdrfl", opts, &option_index);
c = getopt_long(argc, argv, "i:m:d:r:f:l:p:", opts, &option_index);
#else
c = getopt(argc, argv, "imdrflp");
c = getopt(argc, argv, "i:m:d:r:f:l:p:");
#endif
if (c==EOF)
break;
if (c=='?') {
optind--;
break;
}
switch (c) {
case 'i': imagename = optarg; break;
case 'm': dictsize = convsize(optarg,sizeof(Cell)); break;
case 'd': dsize = convsize(optarg,sizeof(Cell)); break;
case 'r': rsize = convsize(optarg,sizeof(Cell)); break;
case 'f': fsize = convsize(optarg,sizeof(Float)); break;
case 'l': lsize = convsize(optarg,sizeof(Cell)); break;
case 'p': path = optarg; break;
}
}
path1=path;
do {
char *pend=strchr(path, ':');
if (pend==NULL)
pend=path+strlen(path);
if (strlen(path)==0) {
fprintf(stderr,"%s: cannot open image file %s in path %s for reading\n", progname, imagename, path1);
exit(1);
}
{
int dirlen=pend-path;
char fullfilename[dirlen+strlen(imagename)+2];
memcpy(fullfilename, path, dirlen);
if (fullfilename[dirlen-1]!='/')
fullfilename[dirlen++]='/';
strcpy(fullfilename+dirlen,imagename);
image_file=fopen(fullfilename,"rb");
}
path=pend+(*pend==':');
} while (image_file==NULL);
{
Cell environ[]= {(Cell)argc-(optind-1), (Cell)(argv+(optind-1)), (Cell)path1};
argv[optind-1] = progname;
/*
for (i=0; i<environ[0]; i++)
printf("%s\n", ((char **)(environ[1]))[i]);
*/
retvalue=go_forth(loader(image_file),3,environ);
deprep_terminal();
exit(retvalue);
}
if (c==EOF)
break;
if (c=='?') {
optind--;
break;
}
switch (c) {
case 'i': imagename = optarg; break;
case 'm': dictsize = convsize(optarg,sizeof(Cell)); break;
case 'd': dsize = convsize(optarg,sizeof(Cell)); break;
case 'r': rsize = convsize(optarg,sizeof(Cell)); break;
case 'f': fsize = convsize(optarg,sizeof(Float)); break;
case 'l': lsize = convsize(optarg,sizeof(Cell)); break;
case 'p': path = optarg; break;
}
}
path1=path;
do {
char *pend=strchr(path, ':');
if (pend==NULL)
pend=path+strlen(path);
if (strlen(path)==0) {
fprintf(stderr,"%s: cannot open image file %s in path %s for reading\n",
progname, imagename, path1);
exit(1);
}
{
int dirlen=pend-path;
char fullfilename[dirlen+strlen(imagename)+2];
memcpy(fullfilename, path, dirlen);
if (fullfilename[dirlen-1]!='/')
fullfilename[dirlen++]='/';
strcpy(fullfilename+dirlen,imagename);
image_file=fopen(fullfilename,"rb");
}
path=pend+(*pend==':');
} while (image_file==NULL);
{
Cell environ[]= {
(Cell)argc-(optind-1),
(Cell)(argv+(optind-1)),
(Cell)path1};
argv[optind-1] = progname;
/*
for (i=0; i<environ[0]; i++)
printf("%s\n", ((char **)(environ[1]))[i]);
*/
retvalue=go_forth(loader(image_file),3,environ);
deprep_terminal();
exit(retvalue);