code: 9ferno

Download patch

ref: 1a03a8efe0d817fac73608db7b8a0ea87ff51577
parent: 121d65ecf2a75d9c130db01c721d4bf38e9311fa
author: 9ferno <gophone2015@gmail.com>
date: Thu Nov 18 06:32:02 EST 2021

partial development of devforth

--- a/os/pc64/bindings.s
+++ b/os/pc64/bindings.s
@@ -22,10 +22,10 @@
 	TESTQ $0, CX
 	JZ .ff_to_c_done /* no args */
 	MOVQ TOS, RARG	/* 1st argument is put in RARG also */
-.ff_to_c_again
+.ff_to_c_again:
 	PUSHQ TOS
 	POP(TOS)
-	LOOP .ff_to_cagain
+	LOOP .ff_to_c_again
 .ff_to_c_done:
 	PUSH(TOS)
 	PUSH(RSP)
@@ -42,7 +42,7 @@
 	POP(TOS)
 	RET
 TEXT	c_to_ff_1(SB), 1, $-4	/* there is a returned argument */
-	call c_to_ff_0(SB)
+	CALL c_to_ff_0(SB)
 	PUSH(TOS)
 	MOVQ AX, TOS	/* C puts the return value in AX */
 	RET
@@ -59,7 +59,7 @@
 	PUSH(TOS)
 	MOVQ $1, TOS
 	CALL ff_to_c(SB)
-	CALL kclose
+	CALL kclose(SB)
 	CALL c_to_ff_1(SB)
 	NEXT
 
--- a/os/pc64/forth.s
+++ b/os/pc64/forth.s
@@ -54,6 +54,12 @@
 SSTACK_END = FFEND
 */
 
+#define TOS BX /* top of stack register */
+#define PSP DX /* parameter stack pointer, grows towards lower memory (downwards) */
+#define RSP R8 /* return stack pointer, grows towards higher memory (upwards) */
+#define IP  R9 /* instruction pointer */
+#define W   R10/* work register (holds CFA) */
+
 #define SSTACK_SIZE 4096
 #define RSTACK_SIZE 4096
 #define	LAST $centry_c_boot(SB) /* last defined word, should generate this */
@@ -67,80 +73,7 @@
 	v_ for colon variable word cfa
  */
 #include "primitives.s"
-#include "bindings.s"
 
-#define PUSHALL \
-	PUSHQ	R13; \
-	PUSHQ	R12; \
-	PUSHQ	R11; \
-	PUSHQ	R10; \
-	PUSHQ	R9; \
-	PUSHQ	R8; \
-	PUSHQ	R8; \
-	PUSHQ	R10; \
-	PUSHQ	R9; \
-	PUSHQ	DX; \
-	PUSHQ	CX; \
-	PUSHQ	BX; \
-	PUSHQ	TOS;
-#define POPALL \
-	POPQ	TOS; \
-	POPQ	BX; \
-	POPQ	CX; \
-	POPQ	DX; \
-	POPQ	R9; \
-	POPQ	R10; \
-	POPQ	R8; \
-	POPQ	R8; \
-	POPQ	R9; \
-	POPQ	R10; \
-	POPQ	R11; \
-	POPQ	R12; \
-	POPQ	R13;
-#define PUSHREGS \
-	PUSHQ	R8; \
-	PUSHQ	R10; \
-	PUSHQ	R9; \
-	PUSHQ	TOS;
-#define POPREGS \
-	POPQ	TOS; \
-	POPQ	R9; \
-	POPQ	R10; \
-	POPQ	R8;
-
-#define FF_TO_C_0 \
-	PUSHREGS; \
-	MOVQ DX, forthsp<>(SB); \
-	MOVQ csp<>(SB), DX; \
-	POPREGS;
-
-#define FF_TO_C_1 \
-	MOVQ TOS, BX; \
-	POPQ TOS; /* drop TOS from the parameter stack */ \
-	FF_TO_C_0 \
-	MOVQ BX, R8; /* 1st argument in R8 == RARG */
-
-/* ( 1st_parameter 2nd_parameter -- ) */
-#define FF_TO_C_2 /* for calling a c function with 2 parameters */ \
-	MOVQ TOS, CX; \
-	POPQ TOS; \
-	FF_TO_C_1 \
-	MOVQ CX, 8(DX) \
-
-/* ( 1st_parameter 2nd_parameter 3rd_parameter -- ) */
-#define FF_TO_C_3 /* for calling a c function with 3 parameters */ \
-	MOVQ TOS, DX; \
-	POPQ TOS; \
-	FF_TO_C_2 \
-	MOVQ DX, 16(DX) \
-
-/* no arguments when calling ff from C, for now */
-#define C_TO_FF \
-	PUSHREGS; \
-	MOVQ DX, csp<>(SB); \
-	MOVQ ffsp<>(SB), DX; \
-	POPREGS;
-
 TEXT	forthmain(SB), 1, $-4		/* _main(SB), 1, $-4 without the libc */
 	/* The last dictionary entry address is stored in dtop.
 	 * The location of dtop is stored in the variable dp.
@@ -164,7 +97,7 @@
 	ADDQ $16, TOS	/* TOS += link (8 bytes) + len (1 byte) + minimum for align to 8 bytes */
 	XORQ CX, CX
 	MOVB 8(SI), CL	/* CL = length of boot name */
-	ADDQ CX, TOS		/* TOS += len */
+	ADDQ CX, TOS	/* TOS += len */
 	ANDQ $~7, TOS	/* TOS = address of boot's code - 8 bytes */
 	LEAQ 8(TOS), IP	/* IP = L257 = start of boot code = has docol address there
 					 * skipping over docol as we do not need to save the IP
@@ -172,12 +105,7 @@
 
 /* lodsl could make this simpler. But, this is more comprehensible
 	why not JMP* (W)?
- */
-#define NEXT	MOVQ (IP), W; /* W = Address next to the DOCOL of boot */ \
-		ADDQ $8, IP; /* move IP further = DOCOL address + 16 */ \
-		MOVQ (W), TOS; /* TOS = code field address of the 1st instruction after DOCOL of boot */ \
-		JMP* TOS; /* Start executing that code field address */
-/*
+
 Address   0     8    16
 aword : docol  40   ...
 Address   40    48
@@ -230,17 +158,19 @@
 	MOVQ (IP),IP
 	NEXT
 
-/* ( f -- ) cjump address
+/*
+	( f -- ) cjump address
 	if true, skip the address and continue
-	else, go to the address */
+	else, go to the address
+ */
 TEXT	cjump(SB), 1, $-4	/* ( f -- ) */
-	MOVQ (IP), TOS	/* get the next address */
+	MOVQ (IP), CX	/* get the next address */
 	ADDQ $8, IP	/* move esi beyond that */
 	TESTQ TOS, TOS
 	JNZ .l1		/* if true, move along */
-	MOVQ TOS, IP	/* if false, go to the above address */
+	MOVQ CX, IP	/* if false, go to the above address */
 .l1:
-	POP(TOS
+	POP(TOS)
 	NEXT
 
 /* TODO change to allow only fetches from a certain memory range */
@@ -267,6 +197,7 @@
 	POP(TOS)
 	NEXT
 
+/* TODO fix this */
 TEXT	terminate(SB), 1, $-4	/* ( n -- ) */
 	XORQ CX, CX
 	TESTQ TOS, TOS
@@ -278,24 +209,6 @@
 	MOVQ CX, a0+0(FP)	/* address of exit status? status = nil? */
 	MOVQ $8, RARG	/* EXITS */
 	SYSCALL		/* TODO syscall for exit */
-
-TEXT	testfsopen(SB), 1, $-4
-	PUSHQ SI	/* for some reason, the syscall is changing IP and W */
-	PUSHQ BP
-	PUSHQ $0	/* OREAD */
-	PUSHQ $name(SB)
-	PUSHQ $0	/* dummy retaddr */
-	MOVQ $14, RARG	/* open */
-	SYSCALL
-	ADDQ $24, PSP
-	POPQ RSP
-	POPQ IP
-	NEXT
-	NOP
-	NOP
-	NOP
-	NOP
-	NOP
 
 #include "bindings.s"
 
--- a/os/pc64/mkfile
+++ b/os/pc64/mkfile
@@ -24,7 +24,7 @@
 
 OBJ=\
 	l.$O\
-	ff.$O\
+	forth.$O\
 	fpu.$O\
 	portclock.$O\
 	tod.$O\
@@ -90,7 +90,7 @@
 main.$O:	$ROOT/Inferno/$OBJTYPE/include/ureg.h rebootcode.i
 trap.$O:	$ROOT/Inferno/$OBJTYPE/include/ureg.h
 
-ff.$O:	primitives.s words.s
+forth.$O:	primitives.s words.s bindings.s
 primitives.s:	primitives.awk primitives-nasm.s
 	cat primitives-nasm.s | ./primitives.awk > primitives.s
 words.s:	words.awk words-nasm.s
--- a/os/pc64/pc64
+++ b/os/pc64/pc64
@@ -4,6 +4,7 @@
 	cons
 	arch
 	env
+	forth
 	mnt
 	pipe
 	proc
--- a/os/pc64/primitives-nasm.s
+++ b/os/pc64/primitives-nasm.s
@@ -3,7 +3,6 @@
   MENTRY "!", store, 1
   MENTRY "c@", cfetch, 2
   MENTRY "c!", cstore, 2
-  MENTRY "testfsopen", testfsopen, 10
   MENTRY "errstr", errstr, 6
   MENTRY "read", read, 4
   MENTRY "write", write, 5
--- a/os/port/pgrp.c
+++ b/os/port/pgrp.c
@@ -194,7 +194,10 @@
 /*	dumppgrp("	to	\n	", to); */
 }
 
-/* not used by 9front. why? */
+/* not used by 9front. why?
+ *	because, we need to be connected to the parent to communicate
+ *	hence, dupfgrp() is used
+ */
 Fgrp*
 newfgrp(Fgrp *old)
 {
--- a/os/port/portdat.h
+++ b/os/port/portdat.h
@@ -702,8 +702,8 @@
 	Mach	*wired;
 	Mach	*mp;		/* machine this process last ran on */
 	int	nlocks;		/* number of locks held by proc */
-	ulong	delaysched;
-	ulong	priority;	/* priority level */
+	u32	delaysched;
+	u32	priority;	/* priority level */
 /*	ulong	basepri;	*//* base priority level */
 /*	uchar	fixedpri;	*//* priority level deson't change */
 /*	ulong	cpu;		*//* cpu average */
--- a/os/port/portfns.h
+++ b/os/port/portfns.h
@@ -102,6 +102,7 @@
 Chan*		fdtochan(Fgrp*, int, int, int, int);
 int		findmount(Chan**, Mhead**, int, int, Qid);
 void		forceclosefgrp(void);
+void		forthmain(void *);
 void		free(void*);
 void		freeb(Block*);
 void		freeblist(Block*);
--- a/os/port/proc.c
+++ b/os/port/proc.c
@@ -463,10 +463,9 @@
 	p->noteid = 0;
 	p->trace = 0;
 
-	/* replaced with pidalloc() in kproc */
-/*	p->pid = incref(&pidalloc);
+	pidalloc(p);
 	if(p->pid == 0)
-		panic("pidalloc"); */
+		panic("pidalloc");
 	if(p->kstack == 0)
 		p->kstack = smalloc(KSTACK);
 	addprog(p);
@@ -881,11 +880,12 @@
 	panic("pexit");
 }
 
-/* 9front uses a macro for this. why? */
+/* macro for speed? */
 Proc*
 proctab(int i)
 {
-	return &procalloc.arena[i];
+#define proctab(x) (&procalloc.arena[(x)])
+	return proctab(i);
 }
 
 void
@@ -990,10 +990,9 @@
 /*	cycles(&p->kentry);
 	p->pcycles = -p->kentry;*/
 
-	pidalloc(p);
-
 	qunlock(&p->debug);
 
+	/* leaving the priority at PriNormal */
 /*	procpriority(p, PriKproc, 0);*/
 
 	p->psstate = nil;
@@ -1031,13 +1030,14 @@
 
 	if(up->nerrlab >= NERR)
 		panic("error stack too deep");
+	if(err == nil)
+		panic("error: nil parameter");
+	kstrcpy(up->env->errstr, err, ERRMAX);
 	if(emptystr(err) == 1){
 		DBG("error nil error err %s caller 0x%p\n", err, getcallerpc(&err));
-		up->env->errstr[0] = '\0';
 		up->env->errpc = 0;
 		/* showerrlabs(); */
 	}else{
-		kstrcpy(up->env->errstr, err, ERRMAX);
 		up->env->errpc = getcallerpc(&err);
 		/* proactively show issues */
 		/* print("up->nerrlab %d error %s raised by 0x%zx\n",