Merge branch 'master' of github.com:jamesbowman/swapforth

j1a/j4a_multithread_example.fs

@@ -1,43 +1,72 @@
 \ Examples for the j4a's multitasking capabilities.
+\ You probably don't want to #include this
 
-: assign1 ( xt -- ) $100 io! ;
-: assign2 ( xt -- ) $200 io! ;
-: assign3 ( xt -- ) $400 io! ;
-: kill1 2 $4000 io! ;
-: kill2 4 $4000 io! ;
-: kill3 8 $4000 io! ;
-
+: on1 ( xt -- ) $100 io! ;
+: on2 ( xt -- ) $200 io! ;
+: on3 ( xt -- ) $400 io! ;
+: once ( standard/looping xt -- runonce xt ) 1 or ;
+: kill1 0 on1 2 $4000 io! ;
+: kill2 0 on2 4 $4000 io! ;
+: kill3 0 on3 8 $4000 io! ;
+: stopall 0 on1 0 on2 0 on3 ;
+: killall kill1 kill2 kill3 ;
 \ note killx will only work from slot0, if called by numbered slots, they will only kill themselves.
 
+\ and now for very simple "model-view-controller" app
+\ this exploitsthe j4's architecture to break the system design into separate, simple pieces
 
 variable display
 variable delay
 
 0 display !
 42 delay !
 
-: update display @ 1 + display ! ;
-: show display @ leds ;
-' show assign1 \ assigns show to slot 1. note no loop.
+
+: show display @ leds ; \ this is the "view" in a MVC. You might have a more complicated "display" function.
+
+' show on1 \ assigns show to slot 1. note no loop.
+
+: update display @ 1 + display ! ; \ this is the "model" in a MVC pattern
 
 : t2 update delay @ ms ;
-' t2 $200 assign2 \ assigns a timed update to slot 2, also no loop.
+' t2 on2 \ assigns a timed update to slot 2, also no loop.
+
+\ leds will count upward, but quit will still run. that was nice and easy, wasn't it?
+
 
-\ leds will count upward, but quit will still run.
 \ try:
 \ 10 delay !
+\ here, user interaction via quit is the "controller" in the MVC pattern, but we could just as well have a small loop polling some switches, running on3
 
-: slowcount 0 0 do i leds 42 ms loop ;
-' slowcount assign3 \ conflicts with the show thread, but both keep running anyway. Note that it has a loop. Will take ~3 hours to finish.
-
+\ now let's sabotage our system:
+: slowcount 0 0 do i leds 10 ms loop ;
+' slowcount on3 \ conflicts with the show thread, but both keep running anyway.
+\ Note that it has a loop. this will take ~3 hours to finish, then will run repeatedly since we forgot to mark it to run just once.
 
 
-0 assign3 \ asks nicely, but does not stop slot 3, because it's paying no attention. (giving a good example of a locked thread).
+0 on3 \ asks nicely, but does not stop slot 3, because it's paying no attention. (giving a good example of a locked thread).
+\ 0 is treated as a special case, it causes the core to just sit and poll again, effectively "stopping" it.
 
-kill3 \ selectively resets just the third slot, which does stop it.
+kill3 \ selectively resets just the third slot, which does do a nondiscretionary interrupt. Also resets its stacks.
+\ note that CTRL-C in the python shell will reset all cores, clearing the stacks, but won't clear the XT's.
 
-0 assign1 0 assign2 \ ask the other two nicely to stop
+0 on1 0 on2 \ ask the other two nicely to stop, in between iterations. A "cooperative" interrupt if you will
+0 leds \ the led's would be left in whatever state, so we have to clean up ourselves.
 
 : offleds 0 leds ;
-' offleds 1 or assign1 \ Run a word just once, not continously. Good for initialisation and cleanup after changing tasks.
+' offleds once on1 \ Run a word just once, not continously. Good for initialisation and cleanup after changing tasks.
 \ Valid XT's are always even, the lsb is used to autoclear the taskexec register after it has been read once by the slot running it.
+\ Note that it is not safe to write XT's one after the other to the same core - it takes several cycles for it to poll for the XT even if it's stopped. so a program with sequential writes *won't* result in each task running one after the next.
+
+\ one need not name one's code:
+:noname -1 leds ; once
+ :noname 0 leds ; once swap on2 on3 \ one core turns leds on, the next will turn them off.
+\ note that without 'once' these will 'fight', resulting in the LEDS's flashing at high speed.
+
+
+\ initialise a core, run for a while, then nicely interrupt that core and clean up before stopping
+:noname 0 ; on1 \ initialise a counter on core 1's stack
+1 ms \ wait a little while, so core 1 does definitely get a chance to run.
+:noname delay @ ms 1+ dup leds ; on1 \ uses just the stack to count on the leds
+10000 ms
+:noname drop 0 leds ; once on1 \ stops and cleans up the stack, also turns the leds off .

j1a/nuc.fs

@@ -130,24 +130,27 @@ header .x
 header execute
 : execute
  >r
+: noop
 ;
 
 header @
 : @
  h# 2000 or execute
 ;
 
+: var: r> ; \ variable defining word
+
 header false : false d# 0 ;
 header true : true d# -1 ;
 header rot : rot >r swap r> swap ;
-header -rot : -rot swap >r swap r> ;
+header -rot : -rot swap >r swap var: ;
 header tuck : tuck swap over ;
 header 2drop : 2drop drop drop ;
 header ?dup : ?dup dup if dup then ;
 
 header 2dup : 2dup over over ;
 header +! : +! tuck @ + swap _! ;
-header 2swap : 2swap rot >r rot r> ;
+header 2swap : 2swap rot >r rot var: ;
 header 2over : 2over >r >r 2dup r> r> 2swap ;
 
 header min : min 2dup<
@@ -198,8 +201,7 @@ header type
  2drop
 ;
 
-: var: r> ; \ variable defining word
-
+create scratch 0 ,
 header base :noname var: create base $a ,
 header state :noname var: create state 0 ,
 header >in :noname var: create >in 0 ,
@@ -250,7 +252,9 @@ header words : words
 \ ;
 
 header abs : abs dup
- : ?neg 0< if negate then ;
+ : ?neg 0<
+ asm-0branch noop
+ negate ;
 header here : here dp @i ;
 
 header /string
@@ -269,25 +273,28 @@ header aligned
 ;
 
 header d+
-: d+ ( augend . addend . -- sum . )
- rot + >r ( augend addend)
- over+ ( augend sum)
- tuck swap ( sum sum augend)
- u< negate ( sum)
- r> + ( sum . )
+: d+ ( al ah bl bh )
+ swap >r + swap ( h al )
+ r@ + swap ( l h )
+ over r> u< -
 ;
 
 header dnegate
 : dnegate
- invert swap invert swap
- d# 1. d+
+ invert
+ swap ( ~hi lo )
+ negate ( ~hi -lo )
+ tuck ( -lo ~hi -lo )
+ 0= -
 ;
 
 header dabs
 : dabs ( d -- ud )
  dup
 : ?dneg ( d n -- d2 ) \ negate d if n is negative
- 0< if dnegate then
+ 0<
+ asm-0branch noop
+ dnegate
 ;
 
 header s>d
@@ -315,8 +322,6 @@ header d0=
 \ begin again
 \ ;
 
-create scratch 0 ,
-
 header d2*
 : d2*
  2* over d# 0 < d# 1 and + swap 2* swap
@@ -574,7 +579,7 @@ header parse-name
  ['] isnotspace?
 : _parse
  xt-skip ( end-word restlen r: start-word )
- 2dup d# 1 min + sourceA @i - >in!
+ 2dup 0<> - sourceA @i - >in!
  drop r>
  tuck -
 ;
@@ -611,7 +616,9 @@ header c,
 
 header compile,
 : compile,
- 2/ h# 4000 or w,
+ 2/ h# 4000
+: orw,
+ or w,
 ;
 
 
@@ -753,7 +760,7 @@ header-imm again
 
 header-imm until
 : tuntil
- h# 2000 or w, \ backward conditional 
+ h# 2000 orw,  \ backward conditional 
 ;
 
 header does>
@@ -932,20 +939,22 @@ header char+ :noname 1+ ;
 header chars :noname noop ;
 
 : jumptable ( u -- ) \ add u to the return address
- r> + >r ;
+ r> + execute ;
 
 header abort
 : abort
  [char] ? emit
  d# 2 execute
 ;
 
-: isvoid ( caddr u -- ) \ any char remains, abort
- nip
+header '
+:noname
+ parse-name
+ sfind
+ 0=
 : ?abort
- if
- abort
- then
+ asm-0branch noop
+ abort
 ;
 
 : consume1 ( caddr u ch -- caddr' u' f )
@@ -954,20 +963,16 @@ header abort
  dup>r negate /string r>
 ;
 
+create signflag 0 ,
+
 : ((doubleAlso))
  h# 0. 2swap
- [char] - consume1 >r
+ [char] - consume1 signflag _!
  >number
- [char] . consume1 if
- isvoid \ double number
- r> ?dneg
- d# 2 exit
- then
- \ single number
- isvoid drop
- r> ?neg
-: return1
- d# 1
+ [char] . consume1 >r \ 0 is single, -1 double
+ nip ?abort \ any chars remain: abort
+ signflag @i ?dneg \ is negative
+ r> ?dup and \ if single, remove high cell
 ;
 
 : base((doubleAlso))
@@ -986,7 +991,7 @@ header abort
  swap d# 2 + is'
 ;
 
-\ (doubleAlso) ( c-addr u -- x 1 | x x 2 )
+\ (doubleAlso) ( c-addr u -- x 0 | x x 1 )
 \ If the string is legal, give a single or double cell number
 \ and size of the number.
 
@@ -1001,7 +1006,7 @@ header abort
  d# 2 base((doubleAlso)) ;
  then
  2dup is'c' if
- drop 1+ c@ return1 ;
+ drop 1+ c@ false ;
  then
  ((doubleAlso))
 ;
@@ -1016,7 +1021,7 @@ header-imm literal
  invert tliteral
  inline: invert
  else
- h# 8000 or w,
+ h# 8000 orw,
  then
 ;
 
@@ -1031,21 +1036,14 @@ header-imm postpone
  compile,
 ;
 
-header '
-:noname
- parse-name
- sfind
- 0= ?abort
-;
-
 header char
 :noname
  parse-name drop c@
 ;
 
 : doubleAlso,
  (doubleAlso)
- 1- if
+ if
  swap tliteral
  then
  tliteral

j1a/swapforth.fs

@@ -39,16 +39,16 @@
  postpone then
 ; immediate
 
+: >body
+ 4 +
+;
+
 : create
  :
- here 4 + postpone literal
+ here >body postpone literal
  postpone ;
 ;
 
-: >body
- @ 32767 and
-;
-
 include core.fs
 
 : /mod >r s>d r> sm/rem ;

j1a/verilator/vsim.cpp

@@ -126,13 +126,11 @@ static void cycle(v3* v)
  dut->clk = 1;
  dut->eval();
 
- int pc = dut->v__DOT___j1__DOT__pc;
- if (pc < 4096) {
- if (dut->v__DOT___j1__DOT__dstack__DOT__depth > v->ddepth[pc])
- v->ddepth[pc] = dut->v__DOT___j1__DOT__dstack__DOT__depth;
- if (dut->v__DOT___j1__DOT__rstack__DOT__depth > v->rdepth[pc])
- v->rdepth[pc] = dut->v__DOT___j1__DOT__rstack__DOT__depth;
- }
+ int pc = 4095 & dut->v__DOT___j1__DOT__pc;
+ if (dut->v__DOT___j1__DOT__dstack__DOT__depth > v->ddepth[pc])
+ v->ddepth[pc] = dut->v__DOT___j1__DOT__dstack__DOT__depth;
+ if (dut->v__DOT___j1__DOT__rstack__DOT__depth > v->rdepth[pc])
+ v->rdepth[pc] = dut->v__DOT___j1__DOT__rstack__DOT__depth;
 }
 
 PyObject *v3_read(PyObject *_, PyObject *args)