[comp.lang.forth] Alan Pratt's C-Forth

usenet@cps3xx.UUCP (Usenet file owner) (10/03/89)

I am using Alan Pratt's C-Forth under SCO XENIX 386 2.3.1 and have the
following problem:

In the editor, when I edit an existing block, mark it for updating,
and flush it out to disk, exit forth, restart forth and look at the
block file, the original block is unchanged and the block which results
from my modifications appears at the end of the block file. 

Is this something which is supposed to occur or is it a bug? If it is
supposed to happen, it is quite annoying for the obvious reasons. I've
been looking through the source code some, but as I am still in the
learning stages of Forth, I haven't come up with anything yet. Has
anyone else come across this problem and fixed it?

The version of C-Forth I am using is from volume 1 of the
comp.unix.sources archive on uunet. Is there a newer version I should
get from elsewhere? 

Advance thanx from a novice Forther,


j				|%|John Lawitzke, Dale Computer Corp., R&D
				|%|UUCP: uunet!frith!dale1!jhl	   	Work
				|%|      uunet!frith!dale1!ipecac!jhl 	Home
Inquiring minds just wondering. |%|Internet: jhl@frith.egr.msu.edu

jax@well.UUCP (Jack J. Woehr) (10/05/89)

usenet@cps3xx.UUCP (Usenet file owner) writes:

>I am using Alan Pratt's C-Forth under SCO XENIX 386 2.3.1 and have the
>following problem:

	The problem you have is you are using Pratt's CForth.

	Cough up the $50 shareware and get Mitch Bradley's CForth-83.


{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
{}                                                                        {}
{} jax@well     ." Sysop, Realtime Control and Forth Board"      FIG      {}
{} jax@chariot  ." (303) 278-0364 3/12/2400 8-n-1 24 hrs."     Chapter    {}
{} JAX on GEnie       ." Tell them JAX sent you!"             Coordinator {}
{}                                                                        {}
{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}

marc@noe.UUCP (Marc de Groot) (10/08/89)

In article <4825@cps3xx.UUCP> jhl@frith.egr.msu.edu () writes:
>I am using Alan Pratt's C-Forth under SCO XENIX 386 2.3.1 and have the
>following problem:
>
>In the editor, when I edit an existing block, mark it for updating,
>and flush it out to disk, exit forth, restart forth and look at the
>block file, the original block is unchanged and the block which results
>from my modifications appears at the end of the block file. 

C-Forth contains significant errors, especially in the disk I/O code.
Try the following fixes.  I have not used the interpreter extensively
but these fixes seem to work on preliminary testing.

The following piece of code contains a fix for the problem you
mentioned.  See the first comment below.  This code fragment
replaces getblockfile() in forth.c

getblockfile()
{
	/* M000 Changed the file mode from "a+" to "r+" on next line
	 * and added the call to fseek. Also added the declaration
	 * of ftell() and fopen().
	 */
	long ftell(); /* M000 */
	FILE *fopen(); /* M000 */

	if ((blockfile = fopen(bfilename, "r+")) == NULL) /* M000 */
		errexit("Can't open blockfile \"%s\"\n", bfilename);
	fseek(blockfile, 0L, 2); /* M000 */
	bfilesize = ftell(blockfile);

	printf("Block file has %d blocks.\n",(int) (bfilesize/1024) - 1);
}

In prims.c replace prslw() with the following code.  SLOWSTACK should not
be defined.  Cell should be typedef'd to int (or whatever is the correct
Forth cell size).  

prslw()
{
	unsigned cell buffer, addr; /* M002 */ /* M003 */
#ifdef SLOWSTACK /* M004 */
	cell pop(); /* M003 */
#endif /* SLOWSTACK -- M004 */
	cell flag; /* M003 */
	int i, temp, unwrittenflag = FALSE; /* M000 */
	long fpos, ftell();
	char buf[1024];		/* holds data for xfer */

	flag = pop();
	buffer = pop();
	addr = pop();
	fpos = (long) (buffer * 1024);

					/* extend if necessary */
	if (fpos >= bfilesize) {
	    if (flag == 0) { 		/* write */
		printf("Extending block file to %ld bytes\n", fpos+1024); /* M001 */
		/* the "2" below is the fseek magic number for "beyond end" */
		fseek(blockfile, (fpos+1024) - bfilesize, 2);
		bfilesize = ftell(blockfile);
	    }
	    else {			/* reading unwritten data */
		unwrittenflag = TRUE;	/* will read all zeroes */
	    }
	}
	else {
		/* note that "0" below is fseek magic number for "relative to
		   beginning-of-file" */
		fseek(blockfile, fpos, 0);	/* seek to destination */
	}

	if (flag) {		/* read */
	    if (unwrittenflag) {	/* not written yet */
		for (i=0; i<1024; i++) mem[addr++] = 0;	/* "read" nulls */
	    }
	    else {			/* does exist */
		if ((temp = fread (buf, sizeof(char), 1024, blockfile)) 
								!= 1024) {
			fprintf (stderr,
				"File read error %d reading buffer %d\n",
					temp, buffer);
			errexit();
		}
		for (i=0; i<1024; i++) mem[addr++] = buf[i];
	    }
	}
	else {	/* write */
		for (i=0; i<1024; i++) buf[i] = mem[addr++];
		if ((temp = fwrite (buf, sizeof(char), 1024, blockfile))
								 != 1024) {
			    fprintf(stderr,
				"File write error %d writing buffer %d\n",
					temp, buffer);
			    errexit();
		}
	}
}


-- 
Marc de Groot (KG6KF)                   These ARE my employer's opinions!
Noe Systems, San Francisco
UUCP: uunet!hoptoad!noe!marc
Internet: marc@kg6kf.AMPR.ORG