Skip to content

Instantly share code, notes, and snippets.

@eparadis
Created October 15, 2021 00:22
Show Gist options
  • Save eparadis/2ba5fcd2ba394561c3540d745bc6bd47 to your computer and use it in GitHub Desktop.
Save eparadis/2ba5fcd2ba394561c3540d745bc6bd47 to your computer and use it in GitHub Desktop.
All the examples from sector forth concatenated, trimmed, and immediate executions removed. The idea is that this is what you would provide to get a running system
: dup sp@ @ ;
: -1 dup dup nand dup dup nand nand ;
: 0 -1 dup nand ;
: 1 -1 dup + dup nand ;
: 2 1 1 + ;
: 4 2 2 + ;
: 6 2 4 + ;
: invert dup nand ;
: and nand invert ;
: negate invert 1 + ;
: - negate + ;
: = - 0= ;
: <> = invert ;
: drop dup - + ;
: over sp@ 2 + @ ;
: swap over over sp@ 6 + ! sp@ 2 + ! ;
: nip swap drop ;
: 2dup over over ;
: 2drop drop drop ;
: or invert swap invert and invert ;
: , here @ ! here @ 2 + here ! ;
: 2* dup + ;
: 80h 1 2* 2* 2* 2* 2* 2* 2* ;
: immediate latest @ 2 + dup @ 80h or swap ! ;
: [ 0 state ! ; immediate
: ] 1 state ! ;
: branch rp@ @ dup @ + rp@ ! ;
: ?branch 0= rp@ @ @ 2 - and rp@ @ + 2 + rp@ ! ;
: lit rp@ @ dup 2 + rp@ ! @ ;
: ['] rp@ @ dup 2 + rp@ ! @ ;
: >rexit rp@ ! ;
: >r rp@ @ swap rp@ ! >rexit ;
: r> rp@ 2 + @ rp@ @ rp@ 2 + ! lit [ here @ 6 + , ] rp@ ! ;
: rot >r swap r> swap ;
: if ['] ?branch , here @ 0 , ; immediate
: then dup here @ swap - swap ! ; immediate
: else ['] branch , here @ 0 , swap dup here @ swap - swap !; immediate
: begin here @ ; immediate
: while ['] ?branch , here @ 0 , ; immediate
: repeat swap ['] branch , here @ - , dup here @ swap - swap ! ; immediate
: until ['] ?branch , here @ - , ; immediate
: do here @ ['] >r , ['] >r , ; immediate
: loop ['] r> , ['] r> , ['] lit , 1 , ['] + , ['] 2dup , ['] = , ['] ?branch , here @ - , ['] 2drop , ; immediate
: 0fh lit [ 4 4 4 4 + + + 1 - , ] ;
: ffh lit [ 0fh 2* 2* 2* 2* 0fh or , ] ;
: c@ @ ffh and ;
: c! dup @ ffh invert and rot ffh and or swap ! ;
: c, here @ c! here @ 1 + here ! ;
: litstring rp@ @ dup 2 + rp@ ! @ rp@ @ swap 2dup + rp@ ! ;
: type 0 do dup c@ emit 1 + loop drop ;
: in> tib >in @ + c@ >in dup @ 1 + swap ! ;
: bl lit [ 1 2* 2* 2* 2* 2* , ] ;
: parse in> drop tib >in @ + swap 0 begin over in> <> while 1 + repeat swap bl = if >in dup @ 1 - swap ! then ;
: word in> drop begin dup in> <> until >in @ 2 - >in ! parse ;
: [char] ['] lit , bl word drop c@ , ; immediate
: ." [char] " parse state @ if ['] litstring , dup , 0 do dup c@ c, 1 + loop drop ['] type , else type then ; immediate
: 0<> 0= invert ;
: 40h lit [ 1 2* 2* 2* 2* 2* 2* , ] ;
: reveal latest @ 2 + dup @ 40h invert and swap ! ;
: create
: ['] lit , here @ 4 + , ['] exit , reveal 0 state !
: cells lit [ 2 , ] ;
: allot here @ + here ! ;
: variable create 1 cells allot ;
: ?dup dup ?branch [ 4 , ] dup ;
: -rot rot rot ;
: xor 2dup and invert -rot or and ;
: 8000h lit [ 0 c, 80h c, ] ;
: >= ) - 8000h and 0= ;
: < >= invert ;
: <= 2dup < -rot = or ;
: 0< 0 < ;
: /mod over 0< -rot 2dup xor 0< -rot dup 0< if negate then swap dup 0< if negate then 0 >r begin over 2dup >= while - r> 1 + >r repeat drop nip rot if negate then r> rot if negate then ;
: / /mod nip ;
: mod /mod drop ;
: 10 lit [ 4 4 2 + + , ] ;
: 10h lit [ 4 4 4 4 + + + , ] ;
: hex 10h base ! ;
: decimal 10 base ! ;
: digit dup 10 < if [char] 0 + else 10 - [char] A + then ;
: space bl emit ;
: . -1 swap dup 0< if negate -1 else 0 then >r begin base @ /mod ?dup 0= until r> if [char] - emit then begin digit emit dup -1 = until drop space ;
: sp0 lit [ sp@ , ] ;
: backspace lit [ 4 4 + , ] emit ;
: .s sp@ 0 swap begin dup sp0 < while 2 + swap 1 + swap repeat swap [char] < emit dup . backspace [char] > emit space ?dup if 0 do 2 - dup @ . loop then drop ;
: i rp@ 4 + @ ;
: 3 1 2 + ;
: 5 2 3 + ;
: cr lit [ 4 6 3 + + , ] lit [ 4 6 + , ] emit emit ;
@eparadis
Copy link
Author

It should be noted that like a lot of FORTH code, this isn't exactly portable. Because the minimal capabilities of SectorForth are so low level, a lot of the words here are doing architecture-specific operations. For example, the create word is doing pointer arithmetic.

It might be worth going through this "boot strap" code, remove the non-portable stuff, and then create a new list of primitives needed. Considering the first comment regarding code density, you might actually come out ahead on some platforms.

I think an interesting diagram would be a dependency graph of all of these words.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment