aboutsummaryrefslogtreecommitdiff
path: root/j1/toolchain
diff options
context:
space:
mode:
authorDimitri Sokolyuk <demon@dim13.org>2019-10-30 20:04:56 +0100
committerDimitri Sokolyuk <demon@dim13.org>2019-10-30 20:04:56 +0100
commita76977af62010a392c16010c367185e61e856ffe (patch)
tree56cf4177d5bc0e3ead781d1c60818c13b1df0f3c /j1/toolchain
parentc0165d167d7cb40d80028bcf7a4a6b160b5a7e83 (diff)
mv to docs
Diffstat (limited to 'j1/toolchain')
-rw-r--r--j1/toolchain/basewords.fs92
-rw-r--r--j1/toolchain/cross.fs321
-rw-r--r--j1/toolchain/demo1.fs7
-rw-r--r--j1/toolchain/dump.py36
-rw-r--r--j1/toolchain/go3
-rw-r--r--j1/toolchain/nuc.fs604
-rw-r--r--j1/toolchain/strings.fs25
7 files changed, 0 insertions, 1088 deletions
diff --git a/j1/toolchain/basewords.fs b/j1/toolchain/basewords.fs
deleted file mode 100644
index 6534d2b..0000000
--- a/j1/toolchain/basewords.fs
+++ /dev/null
@@ -1,92 +0,0 @@
-( 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/j1/toolchain/cross.fs b/j1/toolchain/cross.fs
deleted file mode 100644
index 56c0025..0000000
--- a/j1/toolchain/cross.fs
+++ /dev/null
@@ -1,321 +0,0 @@
-( 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/j1/toolchain/demo1.fs b/j1/toolchain/demo1.fs
deleted file mode 100644
index 7c49af4..0000000
--- a/j1/toolchain/demo1.fs
+++ /dev/null
@@ -1,7 +0,0 @@
-: main
- begin
- h# 0 io@
- d# 1 +
- h# 0 io!
- again
-;
diff --git a/j1/toolchain/dump.py b/j1/toolchain/dump.py
deleted file mode 100644
index 283916b..0000000
--- a/j1/toolchain/dump.py
+++ /dev/null
@@ -1,36 +0,0 @@
-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/j1/toolchain/go b/j1/toolchain/go
deleted file mode 100644
index 6570942..0000000
--- a/j1/toolchain/go
+++ /dev/null
@@ -1,3 +0,0 @@
-set -e
-gforth cross.fs basewords.fs nuc.fs
-# python dump.py ../build/firmware/demo0.hex
diff --git a/j1/toolchain/nuc.fs b/j1/toolchain/nuc.fs
deleted file mode 100644
index 846db05..0000000
--- a/j1/toolchain/nuc.fs
+++ /dev/null
@@ -1,604 +0,0 @@
-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/j1/toolchain/strings.fs b/j1/toolchain/strings.fs
deleted file mode 100644
index cbd9b0e..0000000
--- a/j1/toolchain/strings.fs
+++ /dev/null
@@ -1,25 +0,0 @@
-( 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
-;