ref: 2a12d6d0d04bfaea941cb6c37c02c513bcd3ece8
parent: 25d46a497531211ed517e2c78902d873e95b8ca5
author: 9ferno <[email protected]>
date: Mon Nov 22 12:30:37 EST 2021
forth procs read from fd instead of a queue
--- a/os/pc64/forth.s
+++ b/os/pc64/forth.s
@@ -30,8 +30,9 @@
RSP: R8 return stack pointer, grows towards higher memory (upwards)
IP: R9 instruction pointer
W: R10 work register (holds CFA)
- H0: R11 register holding the start of this process's heap memory
- CX, SI, DI, R12-R13 temporary registers
+ UP: R11 register holding the start of this process's heap memory
+ UPE: R12 register holding the end of this process's heap memory -- TODO, use this
+ CX, SI, DI, R13 temporary registers
coding standard
: <name> (S input-stack --- output-stack) (R --- )
@@ -40,8 +41,8 @@
.. fn ;
Heap memory map: uses 8 pages at the start, will increase by *2 when filled up
-H0: variables
- heap start, heapstart, also in H0
+UP: variables
+ heap start, heapstart, also in UP
heap size, heapsize
forth stack pointer, forthsp
dictionary pointer, Dp
@@ -74,7 +75,7 @@
#define RSP R8 /* return stack pointer, grows towards higher memory (upwards) */
#define IP R9 /* instruction pointer */
#define W R10/* work register (holds CFA) */
-#define H0 R11/* start of heap memory */
+#define UP R11/* start of heap memory */
#define PSTACK_SIZE BY2PG
#define RSTACK_SIZE BY2PG
@@ -106,6 +107,7 @@
#define INFD (HEAPSTART+(BY2WD*18))
#define OUTFD (HEAPSTART+(BY2WD*19))
#define ERRFD (HEAPSTART+(BY2WD*20))
+#define EOF (HEAPSTART+(BY2WD*21))
#define ERRSTR (HEAPSTART+(BY2WD*32))
#define WORDB (HEAPSTART+(BY2WD*160)) /* word buffer */
@@ -137,25 +139,25 @@
TEXT forthmain(SB), 1, $-4 /* _main(SB), 1, $-4 without the libc */
/* Argument has the start of heap */
- MOVQ RARG, H0 /* start of heap memory */
+ MOVQ RARG, UP /* start of heap memory */
- MOVQ H0, RSP
+ MOVQ UP, RSP
ADDQ $RSTACK_END, RSP /* return stack pointer, reset */
- MOVQ H0, PSP
+ MOVQ UP, PSP
ADDQ $PSTACK_END, PSP /* parameter stack pointer - stack setup, clear */
- MOVQ PSP, 16(H0) /* parameter stack pointer store, for forth to c */
+ MOVQ PSP, 16(UP) /* parameter stack pointer store, for forth to c */
- MOVQ H0, TOP
+ MOVQ UP, TOP
ADDQ $HEAPSTART, TOP
- MOVQ TOP, (H0) /* store the start address at that address too - magic check */
+ MOVQ TOP, (UP) /* store the start address at that address too - magic check */
ADDQ $(HEAPSIZE-1), TOP
- MOVQ TOP, 8(H0) /* heap end */
+ MOVQ TOP, 8(UP) /* heap end */
- MOVQ H0, TOP
+ MOVQ UP, TOP
ADDQ $DICTIONARY, TOP
- MOVQ TOP, 24(H0) /* dictionary pointer */
- MOVQ $centry_c_boot(SB), 24(H0) /* Latest dictionary entry address */
+ MOVQ TOP, 24(UP) /* dictionary pointer */
+ MOVQ $centry_c_boot(SB), 24(UP) /* Latest dictionary entry address */
/* execute boot */
MOVQ $centry_c_boot(SB), IP
@@ -190,12 +192,12 @@
NEXT
TEXT reset(SB), 1, $-4
- MOVQ H0, RSP
+ MOVQ UP, RSP
ADDQ $RSTACK_END, RSP
NEXT
TEXT clear(SB), 1, $-4
- MOVQ H0, PSP
+ MOVQ UP, PSP
ADDQ $PSTACK_END, PSP
NEXT
@@ -246,6 +248,7 @@
POP(TOP)
NEXT
+/* TODO change to allow only fetches from a certain memory range */
TEXT cfetch(SB), 1, $-4 /* ( a -- c ) */
XORQ CX, CX
MOVB (TOP), CL
@@ -252,6 +255,7 @@
POP(TOP)
NEXT
+/* TODO change to allow only fetches from a certain memory range */
TEXT cstore(SB), 1, $-4 /* ( c a -- ) */
POP(CX)
MOVB CL, (TOP)
@@ -545,7 +549,7 @@
TEXT s0(SB), 1, $-4 /* S0 needs a calculation to come up with the value */
PUSH(TOP)
- MOVQ H0, TOP
+ MOVQ UP, TOP
ADDQ $PSTACK_END, TOP
NEXT
@@ -552,7 +556,7 @@
/* store the forth sp here when going to C */
TEXT forthsp(SB), 1, $-4
PUSH(TOP)
- MOVQ H0, TOP
+ MOVQ UP, TOP
ADDQ $FORTHSP, TOP
NEXT
@@ -560,7 +564,7 @@
#define VARIABLE(name, location) TEXT name(SB), 1, $-4 ;\
PUSH(TOP); \
- MOVQ H0, TOP ;\
+ MOVQ UP, TOP ;\
ADDQ location, TOP ;\
NEXT;
@@ -586,6 +590,7 @@
VARIABLE(Infd, $INFD)
VARIABLE(Outfd, $OUTFD)
VARIABLE(Errfd, $ERRFD)
+VARIABLE(Eof, $EOF)
TEXT forthend(SB), 1, $-4
--- a/os/pc64/primitives-nasm.s
+++ b/os/pc64/primitives-nasm.s
@@ -52,27 +52,27 @@
MENTRY "Wordb", Wordb, 5
MENTRY "Hzero", Hzero, 5
MENTRY "Dp", Dp, 2
- MENTRY `>In`, toIn, 3
- MENTRY `>Limit`, toLimit, 6
- MENTRY `Findadr`, Findadr, 7
- MENTRY `Blk`, Blk, 3
- MENTRY `Args`, Args, 4
- MENTRY `Iobuf`, Iobuf, 5
- MENTRY `Searchlen`, Searchlen, 9
- MENTRY `Base`, Base, 4
- MENTRY `>Num`, toNum, 4
- MENTRY `State`, State, 5
- MENTRY `Abortvec`, Abortvec, 8 ; not sure if these 3 can be constants instead?
- MENTRY `Sourcebuf`, Sourcebuf, 9
- MENTRY `Wordbuf`, Wordbuf, 7
- MENTRY `Infd`, Infd, 7
- MENTRY `Outfd`, Outfd, 7
- MENTRY `Errfd`, Errfd, 7
+ MENTRY ">In", toIn, 3
+ MENTRY ">Limit", toLimit, 6
+ MENTRY "Findadr", Findadr, 7
+ MENTRY "Blk", Blk, 3
+ MENTRY "Args", Args, 4
+ MENTRY "Iobuf", Iobuf, 5
+ MENTRY "Searchlen", Searchlen, 9
+ MENTRY "Base", Base, 4
+ MENTRY ">Num", toNum, 4
+ MENTRY "State", State, 5
+ MENTRY "Abortvec", Abortvec, 8 ; not sure if these 3 can be constants instead?
+ MENTRY "Sourcebuf", Sourcebuf, 9
+ MENTRY "Wordbuf", Wordbuf, 7
+ MENTRY "Infd", Infd, 5
+ MENTRY "Outfd", Outfd, 6
+ MENTRY "Errfd", Errfd, 4
+ MENTRY "Eof", Eof, 0, 3
- MVENTRY "STDIN", STDIN, 0, 5 ; 4 constants from here, CAPITALS
- MVENTRY "STDOUT", STDOUT, 1, 6
- MVENTRY "STDERR", STDERR, 2, 6
- MVENTRY "EOF", EOF, 0, 3
+ MCENTRY "STDIN", STDIN, 0, 5 ; 3 constants from here, CAPITALS
+ MCENTRY "STDOUT", STDOUT, 1, 6
+ MCENTRY "STDERR", STDERR, 2, 6
MENTRY "s0", s0, 2
MENTRY "s@", stackptr, 2 ; puts PSP on stack
--- a/os/pc64/primitives.awk
+++ b/os/pc64/primitives.awk
@@ -42,7 +42,7 @@
tot += 8
addrlabel = sprintf("mentry_%s", label)}
-$2 == "MVENTRY" {+$2 == "MCENTRY" { if(label != ""){ lines[++nlines]=sprintf("GLOBL %s, $%d\n", last, tot);}
@@ -50,22 +50,22 @@
name = $3
label = $4
tot = 0
- writelast("mventry", label, last)- last=sprintf("mventry_%s(SB)", label);- lines[++nlines]=sprintf("DATA mventry_%s+8(SB)/1, $%d\n", label, length(name));+ writelast("mcentry", label, last)+ last=sprintf("mcentry_%s(SB)", label);+ lines[++nlines]=sprintf("DATA mcentry_%s+8(SB)/1, $%d\n", label, length(name)); for(i=1; i<=length(name); i++){- lines[++nlines]=sprintf("DATA mventry_%s+%d(SB)/1, $'%c'\n", label, 8+i, substr(name,i,1));+ lines[++nlines]=sprintf("DATA mcentry_%s+%d(SB)/1, $'%c'\n", label, 8+i, substr(name,i,1));}
tot = 8+i;
# for alignment
if(tot%8 > 0)
tot += 8-(tot%8);
- lines[++nlines]=sprintf("DATA mventry_%s+%d(SB)/8, $constant(SB)\n", label, tot);- lines[++nlines]=sprintf("#define mc_%s(SB) mventry_%s+%d(SB)\n", label, label, tot);+ lines[++nlines]=sprintf("DATA mcentry_%s+%d(SB)/8, $constant(SB)\n", label, tot);+ lines[++nlines]=sprintf("#define mc_%s(SB) mcentry_%s+%d(SB)\n", label, label, tot);tot += 8;
- lines[++nlines]=sprintf("DATA mventry_%s+%d(SB)/8, $%s\n", label, tot, $5);+ lines[++nlines]=sprintf("DATA mcentry_%s+%d(SB)/8, $%s\n", label, tot, $5);tot += 8;
- addrlabel = sprintf("mventry_%s", label)+ addrlabel = sprintf("mcentry_%s", label)}
$1 ~ /:$/ && $1 !~ /^dict:$/ {l=$1
--- a/os/pc64/words-nasm.s
+++ b/os/pc64/words-nasm.s
@@ -258,37 +258,38 @@
L52:
dd m_exitcolon
- CENTRY `key`, c_key, 3
- dd m_Iobuf ; variable iobuf
+ CENTRY `key`, c_key, 3 ; ( -- c ) (G read a single character from the input onto the stack )
dd m_literal
- dd 1
- dd m_Infd ; constant stdin
- dd m_fthread
+ dd 1 ; ( 1 -- )
+ dd m_Iobuf ; variable iobuf to store the character read
+ dd m_Infd
+ dd m_fetch ; ( 1 Iobuf -- 1 Iobuf infd )
+ dd m_fthread ; ( 1 Iobuf infd -- n )
dd c_0eq
- dd m_cjump
- dd L78
- dd mc_EOF
- dd c_on
+ dd m_cjump ; if 0 characters read
+ dd L78 ; if qread n != 0, jump to L78. If n == 0, jump over
+ dd m_Eof
+ dd c_on ; EOF
dd m_literal
- dd -1
+ dd -1 ; return -1 when EOF
dd m_jump
dd L79
L78:
- dd m_Iobuf
- dd m_cfetch
+ dd m_Iobuf ; get the character from Iobuf to stack
+ dd m_cfetch ; ( -- c ) return the character read if not EOF
L79:
dd m_exitcolon
CENTRY `emit`, c_emit, 4 ; ( character -- )
- dd m_Iobuf ; variable iobuf address
- dd m_cstore ; variable iobuf has character
- dd m_Iobuf ; variable iobuf address
+ dd m_Iobuf ; variable iobuf address
+ dd m_cstore ; variable iobuf has character
+ dd m_Iobuf ; variable iobuf address
dd m_literal
dd 1
- dd m_xswap ; ( iobuf 1 -- 1 iobuf )
- dd m_literal
- dd 1 ; stdout
- dd m_fthwrite ; ( 1 iobuf 1 -- )
+ dd m_xswap ; ( iobuf 1 -- 1 iobuf )
+ dd m_Outfd
+ dd m_fetch ; outfd
+ dd m_fthwrite ; ( 1 iobuf outfd -- )
dd m_exitcolon
CENTRY `type`, c_type, 4 ; ( addr n -- )
@@ -744,11 +745,11 @@
dd m_Sourcebuf
dd m_fetch
dd m_exitcolon
- CENTRY `current-input`, c_current_input, 13
+ CENTRY `current-input`, c_current_input, 13 ; ( -- c ) read the next character from the location in Sourcebuf
dd m_toIn
dd m_fetch
dd c_source
- dd m_plus
+ dd m_plus ; Sourcebuf + >In
dd m_cfetch
dd m_exitcolon
CENTRY `save-input`, c_save_input, 10
@@ -777,7 +778,7 @@
dd c_off
dd m_exitcolon
CENTRY `restore-input`, c_restore_input, 13
- dd mc_EOF
+ dd m_Eof
dd c_off
dd m_literal
dd 5
@@ -817,7 +818,8 @@
dd c_abort
L136:
dd m_exitcolon
- CENTRY `next-input`, c_next_input, 10
+
+ CENTRY `next-input`, c_next_input, 10 ; when >In < >Limit ( -- true c ). ( -- 0 false ) otherwise
dd m_toIn
dd m_fetch
dd m_toLimit
@@ -824,9 +826,9 @@
dd m_fetch
dd m_less
dd m_cjump
- dd L139
- dd c_true
- dd c_current_input
+ dd L139 ; >In >= >Limit
+ dd c_true ; >In < >Limit
+ dd c_current_input ; ( -- c )
dd m_jump
dd L140
L139:
@@ -835,66 +837,68 @@
dd c_false
L140:
dd m_exitcolon
- CENTRY `parse`, c_parse, 5
- dd m_rpush
+
+ CENTRY `parse`, c_parse, 5 ; ( c -- a ) Place the counted string in the address in Wordbuf and return that address. c = word delimiter.
+ dd m_rpush ; ( c -- ) (R -- c )
dd m_Wordbuf
- dd m_fetch
- dd c_1plus
+ dd m_fetch ; ( -- Wordb )
+ dd c_1plus ; ( Wordb -- Wordb+1 )
L142:
- dd c_next_input
- dd m_rfetch
- dd c_neq
+ dd c_next_input ; ( Wordb+1 -- Wordb+1 f c )
+ dd m_rfetch ; ( Wordb+1 f c -- Wordb+1 f cinitial ) (R c -- c )
+ dd c_neq ; ( Wordb+1 f c cinitial -- Wordb+1 f f(c!=cinitial) )
dd m_binand
dd m_cjump
- dd L143
- dd c_current_input
+ dd L143 ; ( Wordb+1 ) >In >= >Limit || cinitial == cnew
+ dd c_current_input ; ( Wordb+1 -- Wordb+1 c )
dd m_over
- dd m_cstore
- dd c_1plus
+ dd m_cstore ; ( Wordb+1 c Wordb+1 -- Wordb+1 ) store c at Wordb+1
+ dd c_1plus ; ( Wordb+1 -- Wordb+2 )
dd m_literal
dd 1
dd m_toIn
- dd c_plusstore
+ dd c_plusstore ; >In++
dd m_jump
- dd L142
-L143:
+ dd L142 ; ( Wordb+2 ) repeat
+L143: ; ( Wordb+1 ) >In >= >Limit || cinitial == cnew
dd m_literal
dd 1
dd m_toIn
- dd c_plusstore
- dd m_rpop
- dd m_drop
+ dd c_plusstore ; >In++
+ dd m_rpop ; (Wordb+1 -- Wordb+1 c) (R c -- )
+ dd m_drop ; (Wordb+1 c -- Wordb+1)
dd m_Wordbuf
- dd m_fetch
- dd m_dup
- dd m_rpush
- dd m_minus
- dd c_1minus
- dd m_rfetch
- dd m_cstore
- dd m_rpop
+ dd m_fetch ; (Wordb+1 -- Wordb+1 Wordb)
+ dd m_dup ; (Wordb+1 Wordb -- Wordb+1 Wordb Wordb)
+ dd m_rpush ; (Wordb+1 Wordb Wordb -- Wordb+1 Wordb) (R -- Wordb)
+ dd m_minus ; (Wordb+1 Wordb -- Wordb+1-Wordb) (R -- Wordb)
+ dd c_1minus ; (Wordb+1-Wordb -- Wordb+1-Wordb-1) (R -- Wordb)
+ dd m_rfetch ; (Wordb+1-Wordb-1 Wordb -- Wordb+1-Wordb-1 Wordb) (R -- Wordb)
+ dd m_cstore ; store the length of the string found at Wordb[0]. Counted string at Wordb now.
+ dd m_rpop ; ( -- Wordb) (R Wordb -- )
dd m_exitcolon
- CENTRY `word`, c_word, 4 ; ( c -- )
+
+ CENTRY `word`, c_word, 4 ; ( c -- a ) skip the c's. Placed the counted string in a (as in Wordbuf)
dd m_rpush ; ( -- ) (R -- c )
L145:
- dd c_next_input ; ( -- c2 ) (R c1 -- )
- dd m_rfetch
- dd m_equal
- dd m_binand
+ dd c_next_input ; ( -- f c2 ) (R c1 -- )
+ dd m_rfetch ; ( f cnew -- f cnew cinitial ) (R cinitial -- cinitial )
+ dd m_equal ; ( f cnew cinitial -- f f(cnew==cinitial) ) (R cinitial -- cinitial )
+ dd m_binand ; ( f f2 -- f&&f2 ) (R cinitial -- cinitial )
dd m_cjump
- dd L146
- dd m_literal
+ dd L146 ; >In >= >Limit || cinitial != cnew
+ dd m_literal ; >In < >Limit && cinitial == cnew
dd 1
dd m_toIn
- dd c_plusstore
- dd m_jump
+ dd c_plusstore ; >In++
+ dd m_jump ; repeat
dd L145
L146:
- dd m_rpop
+ dd m_rpop ; ( -- cinitial ) Sourcebuf+>In = location of first non-matching character
dd c_parse
dd m_exitcolon
- CENTRY `accept`, c_accept, 6 ; ( a n -- ) TODO correct below stack notations
+ CENTRY `accept`, c_accept, 6 ; ( a n -- n ) get line or n chars or EOF from input and store at a
dd m_xswap ; ( n a -- )
dd m_dup ; ( n a a -- )
dd m_rpush
@@ -903,59 +907,61 @@
dd c_qdup ; ( n n -- ) (R a a -- )
dd m_cjump ; (if)
dd L149 ; n == 0
- dd c_key ; n > 0 ( n c -- )
- dd m_dup ; ( n c c -- )
+ dd c_key ; n > 0 ( n -- n c )
+ dd m_dup ; ( -- n c c )
dd m_literal
- dd 10 ; ( n c c 10 -- )
- dd m_equal ; ( n c f -- )
- dd m_over ; ( n c f n -- )
+ dd 10 ; ( -- n c c 10 )
+ dd m_equal ; ( n c c 10 -- n c f ) checking for newline
+ dd m_over ; ( -- n c f c )
dd m_literal
- dd -1 ; ( n c f n -1 -- )
- dd m_equal ; ( n c f1 f2 -- )
- dd m_binor ; ( n c f -- )
+ dd -1 ; ( -- n c f c -1 )
+ dd m_equal ; ( -- n c f1 f2 )
+ dd m_binor ; ( -- n c f )
dd m_cjump
dd L150
dd c_2drop ; n == -1 || n == 10 ( -- )
dd m_rpop
dd m_rpop
- dd m_minus
- dd m_exitcolon ; ( 0 -- ) (R -- )
-L150:
+ dd m_minus ; ( -- a2-a1 )
+ dd m_exitcolon ; ( -- n ) (R -- )
+L150: ; not EOF or newline, continue
dd m_rfetch ; ( n c a -- ) (R a a -- )
- dd m_cstore
+ dd m_cstore ; store the character at a
dd m_rpop ; ( n a -- ) (R a -- )
dd c_1plus
- dd m_rpush ; ( n -- ) (R a1 a2 -- )
- dd c_1minus ; ( n-1 -- ) (R a1 a2 -- )
+ dd m_rpush ; ( n -- ) (R a1 -- a1 a2 ) a1 = begin address, a2 = current address
+ dd c_1minus ; ( n -- n-1 )
dd m_jump
- dd L148
-L149: ; n == 0 ( -- ) (R a a -- )
- dd m_rpop
- dd m_rpop ; ( a a -- )
- dd m_minus ; ( 0 -- )
+ dd L148 ; loop again for the next character
+L149: ; n == 0 ( -- ) (R a1 a2 -- )
+ dd m_rpop ; ( -- a2 ) (R a1 a2 -- a1 )
+ dd m_rpop ; ( a2 a1 -- ) (R a1 -- )
+ dd m_minus ; ( a2 a1 -- a2-a1 )
dd m_exitcolon
- CENTRY `query`, c_query, 5
- dd mc_EOF ; constant eof = 0
+ CENTRY `query`, c_query, 5 ; read from input stream into the Text Input Buffer
+ dd m_Eof
+ dd c_off ; clear EOF flag
dd m_Tib ; constant puts address of tibuffer on the top
dd m_literal
- dd 4096 ; ( EOF tibuffer -- EOF tibuffer 4096 )
- dd c_accept ; ( EOF tibuffer 4096 -- n )
- dd m_dup
- dd c_0eq
- dd mc_EOF
- dd m_binand
+ dd 4096 ; ( tibuffer -- tibuffer 4096 )
+ dd c_accept ; ( tibuffer 4096 -- n )
+ dd m_dup ; ( n -- n n )
+ dd c_0eq ; ( n n -- n f )
+ dd m_Eof
+ dd m_fetch
+ dd m_binand ; n == 0 && EOF
dd m_cjump
- dd L152
- dd m_drop
+ dd L152 ; false condition
+ dd m_drop ; n == 0 && EOF ( n -- )
dd c_qrestore_input
dd m_jump
dd L153
-L152:
+L152: ; n > 0
dd m_toLimit
- dd m_store
+ dd m_store ; number of characters to read, >Limit = n
dd m_toIn
- dd c_off
+ dd c_off ; start from 0, >In = 0
L153:
dd m_exitcolon
@@ -1089,15 +1095,16 @@
dd c_abort
L172:
dd m_exitcolon
- CENTRY `interpret`, c_interpret, 9
+
+ CENTRY `interpret`, c_interpret, 9 ; there is stuff in TIB to be interpreted, >In and >Limit are set
L175:
dd c_bl
- dd c_word
+ dd c_word ; ( bl -- a )
dd m_dup
dd m_cfetch
dd c_0neq
dd m_cjump
- dd L176
+ dd L176 ; count at a = 0
dd c_find ; ( a -- ) a = address of counted string
dd m_cjump
dd L177
@@ -1125,8 +1132,9 @@
dd m_jump
dd L175
L176:
- dd m_drop
+ dd m_drop ; count at a = 0, ( a -- )
dd m_exitcolon
+
CENTRY `create`, c_create, 6
dd c_align
dd c_here
@@ -1656,6 +1664,7 @@
dd 0
dd m_terminate
dd m_exitcolon
+
CENTRY `include`, c_include, 7
dd c_bl
dd c_word
@@ -1673,6 +1682,7 @@
dd m_Infd
dd m_store
dd m_exitcolon
+
CENTRY `crash`, c_crash, 5
dd m_literal
dd L251
@@ -1683,27 +1693,15 @@
dd c_abort
dd m_exitcolon
- CENTRY `quit`, c_quit, 4 ; TODO correct below stack notations
+ CENTRY `quit`, c_quit, 4 ; interpreter loop
dd m_reset ; initialize return stack
dd m_clear ; SP = sstack_end, initialize data stack
L253:
dd c_query
dd c_interpret
- dd m_Infd
- dd m_fetch ; ( 0 -- )
- dd c_0eq
- dd m_cjump
- dd L254
- dd m_literal
- dd L255 ; address of string ok
- dd m_literal
- dd 3
- dd c_type ; ( addr n -- ) type
- dd c_cr ; cr
-L254:
dd m_jump
dd L253
- dd m_exitcolon
+ dd m_exitcolon ; why is this needed?
CENTRY `(abort)`, c_parenabort, 7 ; TODO correct below stack notations
dd m_State ; ( m_State -- )
@@ -1712,15 +1710,18 @@
dd m_Sourcebuf ; variable sourcebuf
dd m_store ; variable sourcebuf = address of tibuffer
dd m_Blk ; variable blk
- dd c_off ; off variable blk = 0
- dd mc_STDIN ; stdin
- dd m_Infd ; variable
- dd m_store ; variable Infd = STDIN
+ dd c_off ; off variable blk = 0
+ dd mc_STDIN
+ dd m_Infd
+ dd m_store
dd mc_STDOUT
- dd m_Outfd ; variable
- dd m_store ; variable Outfd = STDOUT
- dd c_quit ; quit resets return stack and data stack
- dd m_exitcolon
+ dd m_Outfd
+ dd m_store
+ dd mc_STDERR
+ dd m_Errfd
+ dd m_store
+ dd c_quit ; quit resets stacks and is the interpreter loop
+ dd m_exitcolon ; why is this needed? quit does not return unless it breaks
CENTRY `oldboot`, c_oldboot, 7 ; TODO correct below stack notations and this is obsolete. leaving it here for reference until it all works well
dd m_reset
@@ -1780,13 +1781,15 @@
dd m_Sourcebuf ; variable sourcebuf
dd m_store ; variable sourcebuf = address of tibuffer
- ; stdin, stdout and stderr are constants
dd mc_STDIN
dd m_Infd
dd m_store ; stdin = 0
dd mc_STDOUT
dd m_Outfd
- dd m_store ; stdout = 1
+ dd m_store
+ dd mc_STDERR
+ dd m_Errfd
+ dd m_store
dd m_State
dd c_off ; off stores 0 at state
--- a/os/port/devforth.c
+++ b/os/port/devforth.c
@@ -12,7 +12,8 @@
*/
enum
{- NForthProc = 256,
+ NForthproc = 256,
+ QMAX = 192*1024-1,
Qtopdir = 0,
Qforthdir,
@@ -19,7 +20,11 @@
Qnew,
Qfprocdir,
Qctl,
+ Qstdin,
+ Qstdout,
+ Qstderr,
Qvars,
+ /* Qlisten, might be good to have later on for servers */
};
/*
@@ -36,16 +41,19 @@
#define PID(q) ((q).vers)
#define NOTEID(q) ((q).vers)
-/* TODO kproc or mechanism to garbage collect these ForthProc */
-typedef struct ForthProc ForthProc;
-struct ForthProc
+/* TODO kproc or mechanism to garbage collect these Forthproc */
+typedef struct Forthproc Forthproc;
+struct Forthproc
{Proc *p;
- ForthProc *prev, *next;
+ 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;
-ForthProc *fhead, *ftail;
+Forthproc *fhead, *ftail;
static QLock forthlock;
static void
@@ -66,41 +74,35 @@
qunlock(&forthlock);
}
-extern int kclose(int fd);
-extern int kopen(char *path, int mode);
-extern s32 kread(int fd, void *va, s32 n);
-extern s32 kwrite(int fd, void *va, s32 n);
-extern char* kfd2path(int fd);
-
extern int forthmain(char *);
void
forthentry(void *fmem)
{int n;
- char buf[1024];
up->type = Unknown;
print("forthentry pid %d forthmem 0x%zx\n", up->pid, (intptr)fmem);- print("forth entry kfd2path(0) %s kfd2path(1) %s\n", kfd2path(0), kfd2path(1));-/*int fd = kopen(kfd2path(1),OREAD);
-while((n = kread(fd, buf, 1024)) > 0)
- print("forth entry %d bytes: %s\n", n, buf);-kclose(fd);*/
-n = forthmain(fmem);
+
+ if(waserror()){+ print("forthentry waserror()\n");+ for(;;){up->state = Dead;+ sched();}
+ }
+ n = forthmain(fmem);
print("forthentry n %d\n", n);- pexit("exit", 0);+/* pexit("exit", 0);*/ for(;;){up->state = Dead;sched();}
}
-ForthProc *
-newforthproc(void)
+Forthproc *
+newforthproc(Chan *cin, Chan *cout, Chan *cerr)
{Proc *p;
Pgrp *pg;
Fgrp *fg;
Egrp *eg;
- ForthProc *f;
+ Forthproc *f;
void *forthmem;
while((p = newproc()) == nil){@@ -116,11 +118,18 @@
p->nerrlab = 0;
kstrdup(&p->env->user, up->env->user);
+
pg = up->env->pgrp;
+ if(pg == nil)
+ panic("newforthproc: nil process group\n");incref(pg);
p->env->pgrp = pg;
- fg = up->env->fgrp;
+ fg = newfgrp(nil);
+ fg->fd[0] = cin;
+ fg->fd[1] = cout;
+ fg->fd[2] = cerr;
+ fg->maxfd = 2;
incref(fg);
p->env->fgrp = fg;
@@ -140,9 +149,24 @@
p->hang = 0;
p->kp = 0;
- f = malloc(sizeof(ForthProc));
+ f = malloc(sizeof(Forthproc));
if(f == nil)
panic("newforthproc\n");+ forthmem = malloc(FORTHHEAPSIZE);
+ 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;
}else{@@ -151,9 +175,6 @@
ftail = f;
}
f->p = p;
- forthmem = nil; /*malloc(FORTHHEAPSIZE);;
- if(forthmem == nil)
- panic("newforthproc forthmem == nil\n");*/nforthprocs++;
/* p->kpfun = func;
@@ -164,11 +185,6 @@
strcpy(p->text, "forth");
-/* if(kpgrp == nil)
- kpgrp = newpgrp();
- p->pgrp = kpgrp;
- incref(kpgrp);*/
-
memset(p->time, 0, sizeof(p->time));
p->time[TReal] = MACHP(0)->ticks;
/* cycles(&p->kentry);
@@ -177,13 +193,6 @@
qunlock(&p->debug);
p->psstate = nil;
- print("newforthproc kfd2path(0) %s kfd2path(1) %s\n", kfd2path(0), kfd2path(1));-/* int n;
-int fd = kopen(kfd2path(1),OREAD);
-n = kwrite(fd, "junk sent to 1\n", strlen("junk sent to 1\n"));- print("sent to forth %d bytes:\n", n);-kclose(fd);*/
-
ready(p);
return f;
}
@@ -197,7 +206,7 @@
forthgen(Chan *c, char *name, Dirtab *, int, int s, Dir *dp)
{Qid q;
- ForthProc *f;
+ Forthproc *f;
char *ename;
u32 pid, path;
s32 slot, i, t;
@@ -307,6 +316,18 @@
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;
}
@@ -368,7 +389,8 @@
u32 pid;
s32 slot;
int omode;
- ForthProc *f;
+ Forthproc *f;
+ Chan *ncin, *ncout, *ncerr;
DBG("forthopen c->path %s omode0 0x%ux\n", chanpath(c), omode0);if(c->qid.type & QTDIR)
@@ -380,7 +402,11 @@
nexterror();
}
if(QID(c->qid) == Qnew){- f = newforthproc();
+ /* TODO set path */
+ ncin = devclone(c);
+ ncout = devclone(c);
+ ncerr = devclone(c);
+ f = newforthproc(ncin, ncout, ncerr);
if(f == nil)
error(Enodev);
slot = procindex(f->p->pid);
@@ -387,6 +413,12 @@
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();
@@ -408,6 +440,9 @@
case Qnew:
break;
case Qctl:
+ case Qstdin:
+ case Qstdout:
+ case Qstderr:
break;
case Qvars:
if(p->kp || p->privatemem)
@@ -446,16 +481,19 @@
return;
}
-int readdone = 0;
s32
-forthread(Chan *c, void *a, s32 n, s64)
+forthread(Chan *c, void *a, s32 n, s64 off)
{Proc *p;
+ Forthproc *f;
+ char *buf;
+ s32 rv = 0;
DBG("forthread c->path %s\n", chanpath(c));if(c->qid.type & QTDIR)
return devdirread(c, a, n, nil, 0, forthgen);
+ f = c->aux;
p = proctab(SLOT(c->qid));
if(p->pid != PID(c->qid))
error(Eprocdied);
@@ -467,14 +505,20 @@
}
switch(QID(c->qid)){case Qctl:
- if(readdone == 0){- readdone = 1;
- } else if (readdone == 1){- n = 0;
- break;
- }
- n = sprint(a, "%d", p->pid);
+ buf = smalloc(16);
+ snprint(buf, 16, "%d", p->pid);
+ 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:
@@ -485,17 +529,53 @@
qunlock(&p->debug);
poperror();
DBG("forthread returning n %d bytes\n", n);- return n;
+ return rv;
}
static s32
-forthwrite(Chan *c, void *, s32, s64)
+forthwrite(Chan *c, void *a, s32 n, s64)
{+ Proc *p;
+ Forthproc *f;
+
DBG("forthwrite c->path %s\n", chanpath(c));if(c->qid.type & QTDIR)
- error(Eisdir);
+ return devdirread(c, a, n, nil, 0, forthgen);
- return 0;
+ f = c->aux;
+ p = proctab(SLOT(c->qid));
+ if(p->pid != PID(c->qid))
+ error(Eprocdied);
+
+ eqlock(&p->debug);
+ if(waserror()){+ qunlock(&p->debug);
+ nexterror();
+ }
+ 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);
+ default:
+ print("unknown qid in forthwriten");+ error(Egreg);
+ }
+
+ qunlock(&p->debug);
+ poperror();
+ DBG("forthwrite returning n %d bytes\n", n);+ return n;
}
Dev forthdevtab = {