code: 9ferno

Info  •  Files  •  Log

working c ffi

--- a/os/pc64/bindings.s

+++ b/os/pc64/bindings.s

@@ -8,7 +8,7 @@

 #define STORE(x,y) \

 	MOVQ $y, CX; \

 	ADDQ UP, CX; \

-	MOVQ x, 0(CX)

+	MOVQ x, 0(CX);

 #define	STOREFORTH \

 	STORE(TOP,FORTHTOP);\

@@ -16,7 +16,8 @@

 	STORE(RSP,FORTHRSP);\

 	STORE(IP,FORTHIP);\

 	STORE(W,FORTHW);\

-	STORE(UP,FORTHUP);

+	STORE(UP,FORTHUP);\

+	STORE(UPE,FORTHUPE);

 #define RESTORE(x,y) \

 	MOVQ $x, CX; \

@@ -29,7 +30,8 @@

 	RESTORE(FORTHRSP,RSP);\

 	RESTORE(FORTHIP,IP);\

 	RESTORE(FORTHW,W);\

-	RESTORE(FORTHUP,UP);

+	RESTORE(FORTHUP,UP);\

+	RESTORE(FORTHUPE,UPE);

 /*

 using

@@ -87,14 +89,18 @@

 	STOREFORTH;

 TEXT	fthopen(SB), 1, $-4	/* ( mode cstr -- fd ) */

+	PUSHQ UP

 	F_TO_C_2

 	CALL kopen(SB)

+	POPQ UP

 	C_TO_F_1

 	NEXT

 TEXT	fthclose(SB), 1, $-4	/* ( fd -- n ) */

+	PUSHQ UP

 	F_TO_C_1

 	CALL kclose(SB)

+	POPQ UP

 	C_TO_F_1

 	NEXT

@@ -102,22 +108,27 @@

 	MOVQ (PSP), CX	/* address = start of heap + address */

 	ADDQ UP, CX

 	MOVQ CX, (PSP)

+	PUSHQ UP

 	F_TO_C_3

 	CALL kread(SB)

+	POPQ UP

 	C_TO_F_1

 	NEXT

-TEXT	fthwrite(SB), 1, $-4	/* ( n a fd -- n2 ) */

+TEXT	fthwrite(SB), 1, $24	/* ( n a fd -- n2 ) */

 	MOVQ (PSP), CX	/* address = start of heap + address */

 	ADDQ UP, CX

 	MOVQ CX, (PSP)

+	PUSHQ UP

 	F_TO_C_3

 	CALL kwrite(SB)

-	C_TO_F_1

+	POPQ UP

 	NEXT

 TEXT	fthseek(SB), 1, $-4	/* ( type pos fd -- n ) */

+	PUSHQ UP

 	F_TO_C_3

 	CALL kseek(SB)

+	POPQ UP

 	C_TO_F_1

 	NEXT

--- a/os/pc64/forth.s

+++ b/os/pc64/forth.s

@@ -25,7 +25,7 @@

 	Changed to

  Leaving AX, SP, BP (RARG), R14, R15 alone to not mess with the C environment

- TOS: BX top of stack register

+ TOP: BX top of stack register

  PSP: DX parameter stack pointer, grows towards lower memory (downwards)

  RSP: R8 return stack pointer, grows towards higher memory (upwards)

  IP:  R9 instruction pointer

@@ -76,6 +76,7 @@

 #define IP  R9 /* instruction pointer */

 #define W   R10/* work register (holds CFA) */

 #define UP	R11/* start of heap memory */

+#define UPE	R12/* end of heap memory */

 #define PSTACK_SIZE BY2PG

 #define RSTACK_SIZE BY2PG

@@ -92,7 +93,8 @@

 #define FORTHIP	(HEAPSTART+(BY2WD*5))

 #define FORTHW	(HEAPSTART+(BY2WD*6))

 #define FORTHUP	(HEAPSTART+(BY2WD*7))

-#define ARGS		(HEAPSTART+(BY2WD*3))

+#define FORTHUPE	(HEAPSTART+(BY2WD*8))

+#define ARGS		(HEAPSTART+(BY2WD*9))

 #define ERRSTR		(HEAPSTART+(BY2WD*16))

 #define WORDB		(HEAPSTART+(BY2WD*144))	/* word buffer */

@@ -166,13 +168,13 @@

 		JMP* CX; /* Start executing at docol address, JMP* = jump to a non-relative address */

 #define PUSH(r)	SUBQ $8, PSP; \

-			MOVQ r, (PSP)

+			MOVQ r, (PSP);

 #define POP(r)	MOVQ (PSP), r; \

-			ADDQ $8, PSP

+			ADDQ $8, PSP;

 #define RPUSH(r)	SUBQ $8, RSP; \

-			MOVQ r, (RSP)

+			MOVQ r, (RSP);

 #define RPOP(r)	MOVQ (RSP), r; \

-			ADDQ $8, RSP

+			ADDQ $8, RSP;

 	NEXT

--- a/os/port/devforth.c

+++ b/os/port/devforth.c

@@ -7,7 +7,12 @@

 static int debug = 0;

-/* TODO

+/*

+ * 1. Provides #f/forth/new to start new forth processes

+ * 2. pipe data between the readers and writers of #f/forth/pid/(stdin stdout stderr)

+		do not do this. too much work. use the existing mechanism.

+		use the parent's Fgrp - easy, simple and it works fine

+	TODO

 	add memory, variables, dictionary, return stack, parameter stack

  */

 enum

@@ -20,9 +25,6 @@

 	Qnew,

 	Qfprocdir,

 	Qctl,

-	Qstdin,

-	Qstdout,

-	Qstderr,

 	Qvars,

 	/* Qlisten, might be good to have later on for servers */

 };

@@ -47,9 +49,6 @@

 {

 	Proc *p;

 	Forthproc *prev, *next;

-	Queue	*rq;			/* queued data waiting to be read */

-	Queue	*wq;			/* queued data waiting to be written */

-	Queue	*eq;			/* returned error packets */

 };

 int nforthprocs = 0;

@@ -74,22 +73,22 @@

 	qunlock(&forthlock);

 }

-extern int forthmain(char *);

+extern intptr forthmain(char *);

 void

 forthentry(void *fmem)

 {

-	int n;

+	intptr n;

 	up->type = Unknown;

 	print("forthentry pid %d forthmem 0x%zx\n", up->pid, (intptr)fmem);

 	if(waserror()){

-		print("forthentry waserror()\n");

+		print("forthentry waserror(): %r\n");

 	for(;;){up->state = Dead;

 	sched();}

 	}

 	n = forthmain(fmem);

-print("forthentry n %d\n", n);

+print("forthentry n %d n 0x%zx\n", n, n);

 /*	pexit("exit", 0);*/

 	for(;;){up->state = Dead;

 	sched();}

@@ -96,7 +95,7 @@

 }

 Forthproc *

-newforthproc(Chan *cin, Chan *cout, Chan *cerr)

+newforthproc(void)

 {

 	Proc *p;

 	Pgrp *pg;

@@ -125,12 +124,9 @@

 	incref(pg);

 	p->env->pgrp = pg;

-	fg = newfgrp(nil);

-	fg->fd[0] = cin;

-	fg->fd[1] = cout;

-	fg->fd[2] = cerr;

-	fg->maxfd = 2;

-	incref(fg);

+	fg = up->env->fgrp;

+	if(fg != nil)

+		incref(fg);

 	p->env->fgrp = fg;

 	eg = up->env->egrp;

@@ -156,16 +152,6 @@

 	if(forthmem == nil)

 		panic("newforthproc forthmem == nil\n");

-	/* need a waserror() around these */

-	/* not bothering with kick() functions */

-	f->rq = qopen(QMAX, Qcoalesce, nil, nil);

-	f->wq = qopen(QMAX, Qkick, nil, nil);

-	if(f->rq == nil || f->wq == nil)

-		error(Enomem);

-	f->eq = qopen(1024, Qmsg, 0, 0);

-	if(f->eq == nil)

-		error(Enomem);

-

 	((intptr*)forthmem)[0] = (intptr)forthmem;

 	if(fhead == nil){

 		fhead = ftail = f;

@@ -212,10 +198,6 @@

 	s32 slot, i, t;

 	Proc *p;

-	DBG("forthgen c->path %s name %s s %d c->qid.path 0x%zux "

-		"slot %d qid %d c->qid.vers %d c->qid.type %d 0x%ux\n",

-		chanpath(c), name, s, c->qid.path, SLOT(c->qid),

-		QID(c->qid), c->qid.vers, c->qid.type, c->qid.type);

 	/*

 	 * if I do .. from #f or #f/forth

 	 */

@@ -222,7 +204,7 @@

 	if(s == DEVDOTDOT){

 		switch(QID(c->qid)){

 		case Qtopdir:

-		case Qforthdir:

+		case Qforthdir: /* the parent of #f/forth is #f */

 			mkqid(&q, Qtopdir, 0, QTDIR);

 			devdir(c, q, "#f", 0, eve, 0555, dp);

 			break;

@@ -233,6 +215,10 @@

 		default:

 			panic("drawwalk %llux", c->qid.path);

 		}

+	DBG("forthgen s == DEVDOTDOT c->path %s name %s s %d mode 0x%ux c->qid.path 0x%zux "

+		"slot %d qid %d c->qid.vers %d c->qid.type %d 0x%ux\n",

+		chanpath(c), name, s, c->mode, c->qid.path, SLOT(c->qid),

+		QID(c->qid), c->qid.vers, c->qid.type, c->qid.type);

 		return 1;

 	}

@@ -245,6 +231,10 @@

 		if(s == 0){

 			mkqid(&q, Qforthdir, 0, QTDIR);

 			devdir(c, q, "forth", 0, eve, 0555, dp);

+	DBG("forthgen Qtopdir c->path %s name %s s %d mode 0x%ux c->qid.path 0x%zux "

+		"slot %d qid %d c->qid.vers %d c->qid.type %d 0x%ux\n",

+		chanpath(c), name, s, c->mode, c->qid.path, SLOT(c->qid),

+		QID(c->qid), c->qid.vers, c->qid.type, c->qid.type);

 			return 1;

 		}

 		return -1;

@@ -259,6 +249,10 @@

 	case Qnew:	/* this label is just a comment(?), has no purpose */

 			mkqid(&q, Qnew, 0, QTFILE);

 			devdir(c, q, "new", 0, eve, 0666, dp);

+	DBG("forthgen Qforthdir c->path %s name %s s %d mode 0x%ux c->qid.path 0x%zux "

+		"slot %d qid %d c->qid.vers %d c->qid.type %d 0x%ux\n",

+		chanpath(c), name, s, c->mode, c->qid.path, SLOT(c->qid),

+		QID(c->qid), c->qid.vers, c->qid.type, c->qid.type);

 			return 1;

 		}

@@ -299,6 +293,10 @@

 			return -1;

 		mkqid(&q, ((slot+1)<<QSHIFT)|Qfprocdir, pid, QTDIR);

 		devdir(c, q, up->genbuf, 0, p->env->user, 0555, dp);

+	DBG("forthgen pid dir c->path %s name %s s %d mode 0x%ux c->qid.path 0x%zux "

+		"slot %d qid %d c->qid.vers %d c->qid.type %d 0x%ux\n",

+		chanpath(c), name, s, c->mode, c->qid.path, SLOT(c->qid),

+		QID(c->qid), c->qid.vers, c->qid.type, c->qid.type);

 		return 1;

 	}

@@ -316,18 +314,6 @@

 		mkqid(&q, path|Qvars, c->qid.vers, QTFILE);

 		devdir(c, q, "vars", 0, p->env->user, 0600, dp);

 		break;

-	case 2:

-		mkqid(&q, path|Qstdin, c->qid.vers, QTFILE);

-		devdir(c, q, "stdin", 0, p->env->user, 0600, dp);

-		break;

-	case 3:

-		mkqid(&q, path|Qstdout, c->qid.vers, QTFILE);

-		devdir(c, q, "stdout", 0, p->env->user, 0600, dp);

-		break;

-	case 4:

-		mkqid(&q, path|Qstderr, c->qid.vers, QTFILE);

-		devdir(c, q, "stderr", 0, p->env->user, 0600, dp);

-		break;

 	default:

 		return -1;

 	}

@@ -337,23 +323,34 @@

 static Chan*

 forthattach(char *spec)

 {

+	Chan *c;

+

 	DBG("forthattach spec %s\n", spec);

-	return devattach('f', spec);

+	c = devattach('f', spec);

+	mkqid(&c->qid, Qtopdir, 0, QTDIR);

+	return c;

 }

 static Walkqid*

 forthwalk(Chan *c, Chan *nc, char **name, s32 nname)

 {

-	DBG("forthwalk c->path %s nc->path %s name[0] %s nname %d\n",

-		chanpath(c), chanpath(nc), name[0], nname);

-	return devwalk(c, nc, name, nname, nil, 0, forthgen);

+ Walkqid* wq;

+	DBG("forthwalk c->path %s c->mode 0x%ux nc->path %s name[0] %s nname %d\n",

+		chanpath(c), c->mode, chanpath(nc), name[0], nname);

+	wq = devwalk(c, nc, name, nname, nil, 0, forthgen);

+	DBG("forthwalk after c->path %s c->mode 0x%ux nc->path %s name[0] %s nname %d\n",

+		chanpath(c), c->mode, chanpath(nc), name[0], nname);

+	return wq;

 }

 static int

 forthstat(Chan *c, uchar *db, s32 n)

 {

+	int i;

 	DBG("forthstat c->path %s\n", chanpath(c));

-	return devstat(c, db, n, nil, 0, forthgen);

+	i= devstat(c, db, n, nil, 0, forthgen);

+	DBG("forthstat after c->path %s c->mode 0x%ux\n", chanpath(c), c->mode);

+	return n;

 }

 /*

@@ -390,11 +387,19 @@

 	s32 slot;

 	int omode;

 	Forthproc *f;

-	Chan *ncin, *ncout, *ncerr;

-	DBG("forthopen c->path %s omode0 0x%ux\n", chanpath(c), omode0);

-	if(c->qid.type & QTDIR)

-		return devopen(c, omode0, nil, 0, forthgen);

+	if(c->qid.type & QTDIR){

+	DBG("forthopen c->qid.type & QTDIR c->path %s mode 0x%ux omode0 0x%ux c->qid.path 0x%zux "

+		"slot %d qid %d c->qid.vers %d c->qid.type %d 0x%ux\n",

+		chanpath(c), c->mode, omode0, c->qid.path, SLOT(c->qid),

+		QID(c->qid), c->qid.vers, c->qid.type, c->qid.type);

+		tc = devopen(c, omode0, nil, 0, forthgen);

+	DBG("forthopen tc->qid.type & QTDIR tc->path %s mode 0x%ux omode0 0x%ux tc->qid.path 0x%zux "

+		"slot %d qid %d tc->qid.vers %d tc->qid.type %d 0x%ux\n",

+		chanpath(c), tc->mode, omode0, tc->qid.path, SLOT(tc->qid),

+		QID(tc->qid), tc->qid.vers, tc->qid.type, tc->qid.type);

+		return tc;

+	}

 	flock();

 	if(waserror()){

@@ -403,10 +408,7 @@

 	}

 	if(QID(c->qid) == Qnew){

 		/* TODO set path */

-		ncin = devclone(c);

-		ncout = devclone(c);

-		ncerr = devclone(c);

-		f = newforthproc(ncin, ncout, ncerr);

+		f = newforthproc();

 		if(f == nil)

 			error(Enodev);

 		slot = procindex(f->p->pid);

@@ -413,12 +415,6 @@

 		if(slot < 0)

 			panic("forthopen");

 		mkqid(&c->qid, Qctl|(slot+1)<<QSHIFT, f->p->pid, QTFILE);

-		mkqid(&ncin->qid, Qstdin|(slot+1)<<QSHIFT, f->p->pid, QTFILE);

-		mkqid(&ncout->qid, Qstdout|(slot+1)<<QSHIFT, f->p->pid, QTFILE);

-		mkqid(&ncerr->qid, Qstderr|(slot+1)<<QSHIFT, f->p->pid, QTFILE);

-		incref(ncin);

-		incref(ncout);

-		incref(ncerr);

 		DBG("forthopen: new proc pid %d\n", f->p->pid);

 	}

 	funlock();

@@ -440,9 +436,6 @@

 	case Qnew:

 		break;

 	case Qctl:

-	case Qstdin:

-	case Qstdout:

-	case Qstderr:

 		break;

 	case Qvars:

 		if(p->kp || p->privatemem)

@@ -469,7 +462,7 @@

 	qunlock(&p->debug);

 	poperror(); /* eqlock */

-	DBG("forthopen returning tc->path %s omode0 0x%ux tc->qid.vers %d\n", chanpath(tc), omode, tc->qid.vers);

+	DBG("forthopen returning tc->path %s omode0 0x%ux tc->qid.vers %d up->pid %d\n", chanpath(tc), omode, tc->qid.vers, up->pid);

 	return tc;

 }

@@ -476,7 +469,7 @@

 static void

 forthclose(Chan *c)

 {

-	DBG("forthclose c->path %s\n", chanpath(c));

+	DBG("forthclose c->path %s up->pid %d\n", chanpath(c), up->pid);

 	/* TODO close the Chan*? */

 	return;

 }

@@ -489,7 +482,7 @@

 	char *buf;

 	s32 rv = 0;

-	DBG("forthread c->path %s\n", chanpath(c));

+	DBG("forthread c->path %s up->pid %d\n", chanpath(c), up->pid);

 	if(c->qid.type & QTDIR)

 		return devdirread(c, a, n, nil, 0, forthgen);

@@ -510,15 +503,6 @@

 		rv = readstr(off, a, n, buf);

 		free(buf);

 		break;

-	case Qstdin:

-		rv = qread(f->rq, a, n);

-		break;

-	case Qstdout:

-		rv = qread(f->wq, a, n);

-		break;

-	case Qstderr:

-		rv = qread(f->eq, a, n);

-		break;

 	case Qvars: /* TODO */

 		error(Ebadarg);

 	default:

@@ -555,15 +539,6 @@

 	switch(QID(c->qid)){

 	case Qctl:

 		print("forthwrite: writing to Qctl, ignored\n");

-		break;

-	case Qstdin:

-		n = qwrite(f->rq, a, n);

-		break;

-	case Qstdout:

-		n = qwrite(f->wq, a, n);

-		break;

-	case Qstderr:

-		n = qwrite(f->eq, a, n);

 		break;

 	case Qvars: /* TODO */

 		error(Ebadarg);

--- a/os/port/print.c

+++ b/os/port/print.c

@@ -24,8 +24,12 @@

 	return -1;

 }

+/* %r does not do anything when used within the kernel.

+ * It works from limbo though as the lib9 errfmt() is

+ * different.

+ */

 int

-errfmt(Fmt*)

+errfmt(Fmt *)

 {

 	return -1;

 }