aboutsummaryrefslogtreecommitdiff
path: root/docs/j1/toolchain
diff options
context:
space:
mode:
Diffstat (limited to 'docs/j1/toolchain')
-rw-r--r--docs/j1/toolchain/basewords.fs92
-rw-r--r--docs/j1/toolchain/cross.fs321
-rw-r--r--docs/j1/toolchain/demo1.fs7
-rw-r--r--docs/j1/toolchain/dump.py36
-rw-r--r--docs/j1/toolchain/go3
-rw-r--r--docs/j1/toolchain/nuc.fs604
-rw-r--r--docs/j1/toolchain/strings.fs25
7 files changed, 1088 insertions, 0 deletions
diff --git a/docs/j1/toolchain/basewords.fs b/docs/j1/toolchain/basewords.fs
new file mode 100644
index 0000000..6534d2b
--- /dev/null
+++ b/docs/j1/toolchain/basewords.fs
@@ -0,0 +1,92 @@
+( J1 base words implemented in assembler JCB 17:27 12/31/11)
+
+: T h# 0000 ;
+: N h# 0100 ;
+: T+N h# 0200 ;
+: T&N h# 0300 ;
+: T|N h# 0400 ;
+: T^N h# 0500 ;
+: ~T h# 0600 ;
+: N==T h# 0700 ;
+: N<T h# 0800 ;
+: N>>T h# 0900 ;
+: N<<T h# 0a00 ;
+: rT h# 0b00 ;
+: [T] h# 0c00 ;
+: io[T] h# 0d00 ;
+: status h# 0e00 ;
+: Nu<T h# 0f00 ;
+
+: T->N h# 0010 or ;
+: T->R h# 0020 or ;
+: N->[T] h# 0030 or ;
+: N->io[T] h# 0040 or ;
+: RET h# 0080 or ;
+
+: d-1 h# 0003 or ;
+: d+1 h# 0001 or ;
+: r-1 h# 000c or ;
+: r-2 h# 0008 or ;
+: r+1 h# 0004 or ;
+
+: imm h# 8000 or tw, ;
+: alu h# 6000 or tw, ;
+: ubranch h# 0000 or tw, ;
+: 0branch h# 2000 or tw, ;
+: scall h# 4000 or tw, ;
+
+
+:: noop T alu ;
+:: + T+N d-1 alu ;
+:: xor T^N d-1 alu ;
+:: and T&N d-1 alu ;
+:: or T|N d-1 alu ;
+:: invert ~T alu ;
+:: = N==T d-1 alu ;
+:: < N<T d-1 alu ;
+:: u< Nu<T d-1 alu ;
+:: swap N T->N alu ;
+:: dup T T->N d+1 alu ;
+:: drop N d-1 alu ;
+:: over N T->N d+1 alu ;
+:: nip T d-1 alu ;
+:: >r N T->R r+1 d-1 alu ;
+:: r> rT T->N r-1 d+1 alu ;
+:: r@ rT T->N d+1 alu ;
+:: @ [T] alu ;
+:: io@ io[T] alu ;
+:: ! T N->[T] d-1 alu
+ N d-1 alu ;
+:: io! T N->io[T] d-1 alu
+ N d-1 alu ;
+:: rshift N>>T d-1 alu ;
+:: lshift N<<T d-1 alu ;
+:: depths status T->N d+1 alu ;
+:: exit T RET r-1 alu ;
+
+\ Elided words
+\ These words are supported by the hardware but are not
+\ part of ANS Forth. They are named after the word-pair
+\ that matches their effect
+\ Using these elided words instead of
+\ the pair saves one cycle and one instruction.
+
+:: 2dupand T&N T->N d+1 alu ;
+:: 2dup< N<T T->N d+1 alu ;
+:: 2dup= N==T T->N d+1 alu ;
+:: 2dupor T|N T->N d+1 alu ;
+:: 2duprshift N>>T T->N d+1 alu ;
+:: 2dup+ T+N T->N d+1 alu ;
+:: 2dupu< Nu<T T->N d+1 alu ;
+:: 2dupxor T^N T->N d+1 alu ;
+:: dup>r T T->R r+1 alu ;
+:: dup@ [T] T->N d+1 alu ;
+:: overand T&N alu ;
+:: over> N<T alu ;
+:: over= N==T alu ;
+:: overor T|N alu ;
+:: over+ T+N alu ;
+:: overu> Nu<T alu ;
+:: overxor T^N alu ;
+:: rdrop T r-1 alu ;
+:: tuck! T N->[T] d-1 alu ;
diff --git a/docs/j1/toolchain/cross.fs b/docs/j1/toolchain/cross.fs
new file mode 100644
index 0000000..56c0025
--- /dev/null
+++ b/docs/j1/toolchain/cross.fs
@@ -0,0 +1,321 @@
+( J1 Cross Compiler JCB 16:55 05/02/12)
+
+\ Usage gforth cross.fs <machine.fs> <program.fs>
+\
+\ Where machine.fs defines the target machine
+\ and program.fs is the target program
+\
+
+variable lst \ .lst output file handle
+
+: h#
+ base @ >r 16 base !
+ 0. bl parse >number throw 2drop postpone literal
+ r> base ! ; immediate
+
+: tcell 2 ;
+: tcells tcell * ;
+: tcell+ tcell + ;
+
+131072 allocate throw constant tflash \ bytes, target flash
+131072 allocate throw constant _tbranches \ branch targets, cells
+tflash 31072 0 fill
+_tbranches 131072 0 fill
+: tbranches cells _tbranches + ;
+
+variable tdp 0 tdp !
+: there tdp @ ;
+: islegal ;
+: tc! islegal tflash + c! ;
+: tc@ islegal tflash + c@ ;
+: tw! islegal tflash + w! ;
+: t! islegal tflash + l! ;
+: t@ islegal tflash + uw@ ;
+: twalign tdp @ 1+ -2 and tdp ! ;
+: talign tdp @ 3 + -4 and tdp ! ;
+: tc, there tc! 1 tdp +! ;
+: t, there t! 4 tdp +! ;
+: tw, there tw! tcell tdp +! ;
+: org tdp ! ;
+
+wordlist constant target-wordlist
+: add-order ( wid -- ) >r get-order r> swap 1+ set-order ;
+: :: get-current >r target-wordlist set-current : r> set-current ;
+
+next-arg included \ include the machine.fs
+
+( Language basics for target JCB 19:08 05/02/12)
+
+warnings off
+:: ( postpone ( ;
+:: \ postpone \ ;
+
+:: org org ;
+:: include include ;
+:: included included ;
+:: marker marker ;
+:: [if] postpone [if] ;
+:: [else] postpone [else] ;
+:: [then] postpone [then] ;
+
+: literal
+ \ dup $f rshift over $e rshift xor 1 and throw
+ dup h# 8000 and if
+ h# ffff xor recurse
+ ~T alu
+ else
+ h# 8000 or tw,
+ then
+;
+
+: literal
+ dup $80000000 and if
+ invert recurse
+ ~T alu
+ else
+ dup $ffff8000 and if
+ dup $F rshift recurse
+ $f recurse
+ N<<T d-1 alu
+ $7fff and recurse
+ T|N d-1 alu
+ else
+ $8000 or tw,
+ then
+ then
+;
+
+( Defining words for target JCB 19:04 05/02/12)
+
+: codeptr tdp @ 2/ ; \ target data pointer as a jump address
+
+: wordstr ( "name" -- c-addr u )
+ >in @ >r bl word count r> >in !
+;
+
+variable link 0 link !
+
+:: header
+ twalign there
+ \ cr ." link is " link @ .
+ link @ tw,
+ link !
+ bl parse
+ dup tc,
+ bounds do
+ i c@ tc,
+ loop
+ twalign
+;
+
+:: :
+ hex
+ codeptr s>d
+ <# bl hold # # # # #>
+ lst @ write-file throw
+ wordstr lst @ write-line throw
+
+ create codeptr ,
+ does> @ scall
+;
+
+:: :noname
+;
+
+:: ,
+ talign
+ t,
+;
+
+:: allot
+ 0 ?do
+ 0 tc,
+ loop
+;
+
+: shortcut ( orig -- f ) \ insn @orig precedes ;. Shortcut it.
+ \ call becomes jump
+ dup t@ h# e000 and h# 4000 = if
+ dup t@ h# 1fff and over tw!
+ true
+ else
+ dup t@ h# e00c and h# 6000 = if
+ dup t@ h# 0080 or r-1 over tw!
+ true
+ else
+ false
+ then
+ then
+ nip
+;
+
+:: ;
+ there 2 - shortcut \ true if shortcut applied
+ there 0 do
+ i tbranches @ there = if
+ i tbranches @ shortcut and
+ then
+ loop
+ 0= if \ not all shortcuts worked
+ s" exit" evaluate
+ then
+;
+:: ;fallthru ;
+
+:: jmp
+ ' >body @ ubranch
+;
+
+:: constant
+ create ,
+ does> @ literal
+;
+
+:: create
+ talign
+ create there ,
+ does> @ literal
+;
+
+( Switching between target and meta JCB 19:08 05/02/12)
+
+: target only target-wordlist add-order definitions ;
+: ] target ;
+:: meta forth definitions ;
+:: [ forth definitions ;
+
+: t' bl parse target-wordlist search-wordlist 0= throw >body @ ;
+
+( eforth's way of handling constants JCB 13:12 09/03/10)
+
+: sign>number ( c-addr1 u1 -- ud2 c-addr2 u2 )
+ 0. 2swap
+ over c@ [char] - = if
+ 1 /string
+ >number
+ 2swap dnegate 2swap
+ else
+ >number
+ then
+;
+
+: base>number ( caddr u base -- )
+ base @ >r base !
+ sign>number
+ r> base !
+ dup 0= if
+ 2drop drop literal
+ else
+ 1 = swap c@ [char] . = and if
+ drop dup literal 32 rshift literal
+ else
+ -1 abort" bad number"
+ then
+ then ;
+warnings on
+
+:: d# bl parse 10 base>number ;
+:: h# bl parse 16 base>number ;
+:: ['] ' >body @ 2* literal ;
+:: [char] char literal ;
+
+:: asm-0branch
+ ' >body @
+ 0branch
+;
+
+( Conditionals JCB 13:12 09/03/10)
+
+: resolve ( orig -- )
+ there over tbranches ! \ forward reference from orig to this loc
+ dup t@ there 2/ or swap tw!
+;
+
+:: if
+ there
+ 0 0branch
+;
+
+:: then
+ resolve
+;
+
+:: else
+ there
+ 0 ubranch
+ swap resolve
+;
+
+:: begin there ;
+
+:: again ( dest -- )
+ 2/ ubranch
+;
+:: until
+ 2/ 0branch
+;
+:: while
+ there
+ 0 0branch
+;
+:: repeat
+ swap 2/ ubranch
+ resolve
+;
+
+4 org
+: .trim ( a-addr u ) \ shorten string until it ends with '.'
+ begin
+ 2dup + 1- c@ [char] . <>
+ while
+ 1-
+ repeat
+;
+include strings.fs
+next-arg 2dup .trim >str constant prefix.
+: .suffix ( c-addr u -- c-addr u ) \ e.g. "bar" -> "foo.bar"
+ >str prefix. +str str@
+;
+: create-output-file w/o create-file throw ;
+: out-suffix ( s -- h ) \ Create an output file h with suffix s
+ >str
+ prefix. +str
+ s" ../build/firmware/" >str +str str@
+ create-output-file
+;
+:noname
+ s" lst" out-suffix lst !
+; execute
+
+
+target included \ include the program.fs
+
+[ tdp @ 0 org ] bootloader main [ org ]
+meta
+
+decimal
+0 value file
+: dumpall.16
+ s" hex" out-suffix to file
+
+ hex
+ 1024 0 do
+ tflash i 2* + w@
+ s>d <# # # # # #> file write-line throw
+ loop
+ file close-file
+;
+: dumpall.32
+ s" hex" out-suffix to file
+
+ hex
+ 4096 0 do
+ tflash i 4 * + @
+ s>d <# # # # # # # # # #> file write-line throw
+ loop
+ file close-file
+;
+
+dumpall.32
+
+bye
diff --git a/docs/j1/toolchain/demo1.fs b/docs/j1/toolchain/demo1.fs
new file mode 100644
index 0000000..7c49af4
--- /dev/null
+++ b/docs/j1/toolchain/demo1.fs
@@ -0,0 +1,7 @@
+: main
+ begin
+ h# 0 io@
+ d# 1 +
+ h# 0 io!
+ again
+;
diff --git a/docs/j1/toolchain/dump.py b/docs/j1/toolchain/dump.py
new file mode 100644
index 0000000..283916b
--- /dev/null
+++ b/docs/j1/toolchain/dump.py
@@ -0,0 +1,36 @@
+import sys
+import array
+
+def hexdump(s):
+ def toprint(c):
+ if 32 <= ord(c) < 127:
+ return c
+ else:
+ return "."
+ def hexline(i, s):
+ return ("%04x: " % i + " ".join(["%02x" % ord(c) for c in s]).ljust(52) +
+ "|" +
+ "".join([toprint(c) for c in s]).ljust(16) +
+ "|")
+ return "\n".join([hexline(i, s[i:i+16]) for i in range(0, len(s), 16)])
+
+pgm = array.array('H', [int(l, 16) for l in open(sys.argv[1])])
+
+while pgm[-1] == 0:
+ pgm = pgm[:-1]
+s = pgm.tostring()
+print
+print hexdump(s)
+
+link = [w for w in pgm[::-1] if w][0]
+words = []
+while link:
+ name = s[link + 2:]
+ c = ord(name[0])
+ name = name[1:1+c]
+ print "%04x %s" % (link, name)
+ assert not name in words
+ words.append(name)
+ link = pgm[link / 2]
+print len(words), " ".join(words)
+print "program size %d/%d" % (len(pgm), 1024)
diff --git a/docs/j1/toolchain/go b/docs/j1/toolchain/go
new file mode 100644
index 0000000..6570942
--- /dev/null
+++ b/docs/j1/toolchain/go
@@ -0,0 +1,3 @@
+set -e
+gforth cross.fs basewords.fs nuc.fs
+# python dump.py ../build/firmware/demo0.hex
diff --git a/docs/j1/toolchain/nuc.fs b/docs/j1/toolchain/nuc.fs
new file mode 100644
index 0000000..846db05
--- /dev/null
+++ b/docs/j1/toolchain/nuc.fs
@@ -0,0 +1,604 @@
+header 1+ : 1+ d# 1 + ;
+header 1- : 1- d# -1 + ;
+header 0= : 0= d# 0 = ;
+header cell+ : cell+ d# 2 + ;
+
+header <> : <> = invert ;
+header > : > swap < ;
+header 0< : 0< d# 0 < ;
+header 0> : 0> d# 0 > ;
+header 0<> : 0<> d# 0 <> ;
+header u> : u> swap u< ;
+
+: eol ( u -- u' false | true )
+ d# -1 +
+ dup 0= dup if
+ ( 0 true -- )
+ nip
+ then
+;
+
+header ms
+: ms
+ begin
+ d# 15000 begin
+ eol until
+ eol until
+;
+
+
+header key?
+: key?
+ d# 0 io@
+ d# 4 and
+ 0<>
+;
+
+header key
+: key
+ begin
+ key?
+ until
+ d# 0 io@ d# 8 rshift
+ d# 0 d# 2 io!
+;
+
+: ready
+ d# 0 io@
+ d# 2 and
+ 0=
+;
+
+header emit
+: emit
+ begin ready until
+ h# 0 io!
+;
+
+header cr
+: cr
+ d# 13 emit
+ d# 10 emit
+;
+
+header space
+: space
+ d# 32 emit
+;
+
+header bl
+: bl
+ d# 32
+;
+
+: hex1
+ h# f and
+ dup d# 10 < if
+ [char] 0
+ else
+ d# 55
+ then
+ +
+ emit
+;
+
+: hex2
+ dup d# 4 rshift hex1 hex1
+;
+
+: hex4
+ dup d# 8 rshift hex2 hex2
+;
+
+: hex8
+ dup d# 16 rshift hex4 hex4
+;
+
+header .
+: . hex8 space ;
+
+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 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 min : min 2dup< if drop else nip then ;
+header max : max 2dup< if nip else drop then ;
+
+header c@
+: c@
+ dup @ swap
+ d# 3 and d# 3 lshift rshift
+ d# 255 and
+;
+
+: hi16
+ d# 16 rshift d# 16 lshift
+;
+
+: lo16
+ d# 16 lshift d# 16 rshift
+;
+
+header uw@
+: uw@
+ dup @ swap
+ d# 2 and d# 3 lshift rshift
+ lo16
+;
+
+header w!
+: w! ( u c-addr -- )
+ dup>r d# 2 and if
+ d# 16 lshift
+ r@ @ lo16
+ else
+ lo16
+ r@ @ hi16
+ then
+ or r> !
+;
+
+header c!
+: c! ( u c-addr -- )
+ dup>r d# 1 and if
+ d# 8 lshift
+ h# 00ff
+ else
+ h# 00ff and
+ h# ff00
+ then
+ r@ uw@ and
+ or r> w!
+;
+
+header count
+: count
+ dup 1+ swap c@
+;
+
+: bounds ( a n -- a+n a )
+ over + swap
+;
+
+header type
+: type
+ bounds
+ begin
+ 2dupxor
+ while
+ dup c@ emit
+ 1+
+ repeat
+ 2drop
+;
+
+create base $a ,
+create ll 0 ,
+create dp 0 ,
+create tib# 0 ,
+create >in 0 ,
+create tib 80 allot
+
+header words : words
+ ll uw@
+ begin
+ dup
+ while
+ cr
+ dup .
+ dup cell+
+ count type
+ space
+ uw@
+ repeat
+ drop
+;
+
+header dump : dump ( addr u -- )
+ cr over hex4
+ begin ( addr u )
+ ?dup
+ while
+ over c@ space hex2
+ 1- swap 1+ ( u' addr' )
+ dup h# f and 0= if ( next line? )
+ cr dup hex4
+ then
+ swap
+ repeat
+ drop cr
+;
+
+header negate : negate invert 1+ ;
+header - : - negate + ;
+header abs : abs dup 0< if negate then ;
+header 2* : 2* d# 1 lshift ;
+header 2/ : 2/ d# 1 rshift ;
+header here : here dp @ ;
+header depth : depth depths h# f and ;
+
+: /string
+ dup >r - swap r> + swap
+;
+
+header aligned
+: aligned
+ d# 3 + d# -4 and
+;
+
+: d+ ( augend . addend . -- sum . )
+ rot + >r ( augend addend)
+ over + ( augend sum)
+ dup rot ( sum sum augend)
+ u< if ( sum)
+ r> 1+
+ else
+ r>
+ then ( sum . )
+;
+
+: d1+ d# 1. d+ ;
+
+: dnegate
+ invert swap invert swap
+ d1+
+;
+
+: dabs ( d -- ud )
+ dup 0< if dnegate then
+;
+
+: s>d dup 0< ;
+: m+
+ s>d d+
+;
+
+: snap
+ cr depth hex2 space
+ begin
+ depth
+ while
+ .
+ repeat
+ cr
+ [char] # emit
+ begin again
+;
+
+create scratch 0 ,
+
+header um*
+: um* ( u1 u2 -- ud )
+ scratch !
+ d# 0.
+ d# 32 begin
+ >r
+ 2dup d+
+ rot dup 0< if
+ 2* -rot
+ scratch @ d# 0 d+
+ else
+ 2* -rot
+ then
+ r> eol
+ until
+ rot drop
+;
+: *
+ um* drop
+;
+
+header accept
+: accept
+ d# 30 emit
+ drop dup
+ begin
+ key
+ dup h# 0d xor
+ while
+ dup h# 0a = if
+ drop
+ else
+ over c! 1+
+ then
+ repeat
+ drop swap -
+;
+
+: 3rd >r over r> swap ;
+: 3dup 3rd 3rd 3rd ;
+
+: sameword ( c-addr u wp -- c-addr u wp flag )
+ 2dup d# 2 + c@ = if
+ 3dup
+ d# 3 + >r
+ bounds
+ begin
+ 2dupxor
+ while
+ dup c@ r@ c@ <> if
+ 2drop rdrop false exit
+ then
+ 1+
+ r> 1+ >r
+ repeat
+ 2drop rdrop true
+ else
+ false
+ then
+;
+
+\ lsb 0 means non-immediate, return -1
+\ 1 means immediate, return 1
+: isimmediate ( wp -- -1 | 1 )
+ uw@ d# 1 and 2* 1-
+;
+
+: sfind
+ ll uw@
+ begin
+ dup
+ while
+ sameword
+ if
+ nip nip
+ dup
+ d# 2 +
+ count +
+ d# 1 + d# -2 and
+ swap isimmediate
+ exit
+ then
+ uw@
+ repeat
+;
+
+: digit? ( c -- u f )
+ dup h# 39 > h# 100 and +
+ dup h# 140 > h# 107 and - h# 30 -
+ dup base @ u<
+;
+
+: ud* ( ud1 u -- ud2 ) \ ud2 is the product of ud1 and u
+ tuck * >r
+ um* r> +
+;
+
+: >number ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 )
+ begin
+ dup
+ while
+ over c@ digit?
+ 0= if drop exit then
+ >r 2swap base @ ud*
+ r> m+ 2swap
+ d# 1 /string
+ repeat
+;
+
+header fill
+: fill ( c-addr u char -- ) ( 6.1.1540 )
+ >r bounds
+ begin
+ 2dupxor
+ while
+ r@ over c! 1+
+ repeat
+ r> drop 2drop
+;
+
+header erase
+: erase
+ d# 0 fill
+;
+
+header execute
+: execute
+ >r
+;
+
+header source
+: source
+ tib tib# @
+;
+
+\ From Forth200x - public domain
+
+: isspace? ( c -- f )
+ bl 1+ u< ;
+
+: isnotspace? ( c -- f )
+ isspace? 0= ;
+
+: xt-skip ( addr1 n1 xt -- addr2 n2 ) \ gforth
+ \ skip all characters satisfying xt ( c -- f )
+ >r
+ BEGIN
+ over c@ r@ execute
+ over 0<> and
+ WHILE
+ d# 1 /string
+ REPEAT
+ r> drop ;
+
+: parse-name ( "name" -- c-addr u )
+ source >in @ /string
+ ['] isspace? xt-skip over >r
+ ['] isnotspace? xt-skip ( end-word restlen r: start-word )
+ 2dup d# 1 min + source drop - >in !
+ drop r> tuck - ;
+
+header ! :noname ! ;
+header + :noname + ;
+header xor :noname xor ;
+header and :noname and ;
+header or :noname or ;
+header invert :noname invert ;
+header = :noname = ;
+header < :noname < ;
+header u< :noname u< ;
+header swap :noname swap ;
+header dup :noname dup ;
+header drop :noname drop ;
+header over :noname over ;
+header nip :noname nip ;
+header @ :noname @ ;
+header io! :noname io! ;
+header rshift :noname rshift ;
+header lshift :noname lshift ;
+\
+\ \ >r
+\ \ r>
+\ \ r@
+\ \ exit
+\
+
+: xmain
+ cr d# 1 ms cr
+ d# 60 begin
+ [char] - emit
+ eol until
+ begin key? while key drop repeat
+
+ cr h# ffff hex8
+
+ d# 0 d# 100 dump
+ words cr cr
+
+ begin again
+
+ begin
+ cr
+ tib d# 30 accept >r
+ d# 0. tib r> >number
+ 2drop hex4 space hex4
+ again
+
+ snap
+;
+
+: route
+ r> + >r ;
+
+\ (doubleAlso) ( c-addr u -- x 1 | x x 2 )
+\ If the string is legal, leave a single or double cell number
+\ and size of the number.
+
+: isvoid ( caddr u -- ) \ any char remains, throw -13
+ nip 0<>
+ if [char] x emit snap then
+;
+
+: consume1 ( caddr u ch -- caddr' u' f )
+ >r over c@ r> =
+ over 0<> and
+ dup>r d# 1 and /string r>
+;
+
+: (doubleAlso)
+ h# 0. 2swap
+ [char] - consume1 >r
+ >number
+ [char] . consume1 if
+ isvoid \ double number
+ r> if dnegate then
+ d# 2 exit
+ then
+ \ single number
+ isvoid drop
+ r> if negate then
+ d# 1
+;
+
+: doubleAlso
+ (doubleAlso) drop
+;
+
+
+: dispatch
+ route ;fallthru
+ jmp execute \ -1 0 non-immediate
+ jmp doubleAlso \ 0 0 number
+ jmp execute \ 1 0 immediate
+
+\ jmp compile_comma \ -1 2 non-immediate
+\ jmp doubleAlso_comma \ 0 2 number
+\ jmp execute \ 1 2 immediate
+
+: interpret
+ begin
+ parse-name dup
+ while
+ sfind
+ 1+ 2* dispatch
+ repeat
+ 2drop
+;
+
+: main
+ 2drop
+ begin
+ tib d# 80 accept
+ tib# !
+ \ h# 40 emit
+ d# 0 >in !
+ source dump
+ \ cr parse-name sfind
+ \ if
+ \ execute
+ \ then
+ interpret
+ again
+;
+
+meta
+ $3f80 org
+target
+
+: b.key
+ begin
+ d# 0 io@
+ d# 4 and
+ until
+ d# 0 io@ d# 8 rshift
+ d# 0 d# 2 io!
+;
+
+: b.32
+ b.key
+ b.key d# 8 lshift or
+ b.key d# 16 lshift or
+ b.key d# 24 lshift or
+;
+
+meta
+ $3fc0 org
+target
+
+: bootloader
+ begin
+ b.key d# 27 =
+ until
+
+ b.32 d# 0
+ begin
+ 2dupxor
+ while
+ b.32 over !
+ d# 4 +
+ repeat
+;
+
+meta
+ link @ t,
+ link @ t' ll tw!
+ there t' dp tw!
+target
diff --git a/docs/j1/toolchain/strings.fs b/docs/j1/toolchain/strings.fs
new file mode 100644
index 0000000..cbd9b0e
--- /dev/null
+++ b/docs/j1/toolchain/strings.fs
@@ -0,0 +1,25 @@
+( Strings JCB 11:57 05/18/12)
+
+: >str ( c-addr u -- str ) \ a new u char string from c-addr
+ dup cell+ allocate throw dup >r
+ 2dup ! cell+ \ write size into first cell
+ ( c-addr u saddr )
+ swap cmove r>
+;
+: str@ dup cell+ swap @ ;
+: str! ( str c-addr -- c-addr' ) \ copy str to c-addr
+ >r str@ r>
+ 2dup + >r swap
+ cmove r>
+;
+: +str ( str2 str1 -- str3 )
+ over @ over @ + cell+ allocate throw >r
+ over @ over @ + r@ !
+ r@ cell+ str! str! drop r>
+;
+
+: example
+ s" sailor" >str
+ s" hello" >str
+ +str str@ type
+;