From a76977af62010a392c16010c367185e61e856ffe Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Wed, 30 Oct 2019 20:04:56 +0100 Subject: mv to docs --- j1/toolchain/basewords.fs | 92 ------- j1/toolchain/cross.fs | 321 ------------------------ j1/toolchain/demo1.fs | 7 - j1/toolchain/dump.py | 36 --- j1/toolchain/go | 3 - j1/toolchain/nuc.fs | 604 ---------------------------------------------- j1/toolchain/strings.fs | 25 -- 7 files changed, 1088 deletions(-) delete mode 100644 j1/toolchain/basewords.fs delete mode 100644 j1/toolchain/cross.fs delete mode 100644 j1/toolchain/demo1.fs delete mode 100644 j1/toolchain/dump.py delete mode 100644 j1/toolchain/go delete mode 100644 j1/toolchain/nuc.fs delete mode 100644 j1/toolchain/strings.fs (limited to 'j1/toolchain') 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# 0900 ; -: N<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 ; -:: < NN 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<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< NN 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< NuN 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 Nu[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 -\ -\ 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<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 -; -- cgit v1.2.3