: \  10 parse 2drop ; immediate \ test
: (  [ char ) ] literal parse 2drop ; immediate ( test )

: binary  2 base ! ;
: octal  8 base ! ;
: decimal  10 base ! ;
: hex  16 base ! ;

: nip  swap drop ;
: tuck  swap over ;

: <mark  here ;
: <resolve  here 4 + - d, ;
: >mark  here 0 d, ;
: >resolve  dup here swap - 4 - swap d! ;

: begin  <mark ; immediate compile-only
: again  branch <resolve ; immediate compile-only
: until  ?branch <resolve ; immediate compile-only
: if  ?branch >mark ; immediate compile-only
: else  branch >mark swap >resolve ; immediate compile-only
: then  >resolve ; immediate compile-only
: while  ?branch >mark ; immediate compile-only
: repeat  branch swap <resolve >resolve ; immediate compile-only

: ?dup  dup 0<> if dup then ;

: allot  dp +! ;

: ?find  ?dup if find 0= if 2drop abort then else abort then ;
: 'h  parse-name ?find ;
: '  'h >body ;
: [compile]  ' ( word ) compile, ; immediate compile-only
: [']  ' ( word ) [compile] literal ; immediate compile-only
: postpone  'h ( word ) dup immediate? if >body compile,
	else >body [compile] literal ['] compile, compile, then ; immediate compile-only

: cells  8 * ;
: cell+  8 + ;
: cell-  8 - ;
: create  parse-name (header) latest ! ['] (create) compile, 0 , ;
: does>  latest @ >body 2 + ['] (does>) over ! \ replace call loc
	( replace destination ) 11 + r> swap ! ;
	( the lone r> means we don't execute the rest of the word now, )
	( but it is actually compiled into the definition and is jumped to )
	( by a create does> made word )
: constant  create , does> @ ;
: variable  create 1 cells allot ;

: value  parse-name (header) latest ! postpone literal
	[ hex ] c3 c, [ decimal ] ; \ c3 = RET
: to  ' ( word ) 6 +  state @ if postpone literal postpone ! else ! then ; immediate
: +to  ' ( word ) 6 +  state @ if postpone literal postpone +! else +! then ; immediate
: -to  ' ( word ) 6 +  state @ if postpone literal postpone -! else -! then ; immediate

0 constant false
-1 constant true

hex
\ really i should just change the builtins to work with defer
: hijacks  ' ( word ) here >r dp ! ( temporarily set dp so we can use , )
	49 c, bb c, ( xt ) , \ mov r11, xt
	41 c, ff c, e3 c, \ jmp r11
	r> dp ! ;
decimal

: cmove,  dup >r  here swap cmove  r> allot ;
: s"  [ char " ] literal parse ( a u )
	branch >mark >r 2dup cmove, nip  ( u ) ( R: mark )
	r> dup >resolve 4 + ( u a )
	postpone literal ( a ) postpone literal ( u ) ; immediate compile-only
: z"  [ char " ] literal parse ( a u )
	branch >mark >r 2dup cmove, 0 c, nip  ( u ) ( R: mark )
	r> dup >resolve 4 + ( u a )
	postpone literal ( a ) drop ; immediate compile-only
: zstrlen  dup begin dup c@ 0<> while 1+ repeat swap - ;
\ todo s>z becomes s>z, s>z writes to pad (will then need to be moved below pno)
: s>z  here -rot cmove, 0 c, ;

\ PRIVATISATION AND HIDING {{{
\ maybe i add locals later, implementation may be complex though. this isn't.
\ privatise just loops through words from the start of privatisation
\ to the end and activates the smudge bit on all of them.
\ privatisation yoinked from pforth

: (hide)  cell+ dup c@ 1 or swap c! ;
: hide  parse-name ?find (hide) ;

variable private0  variable private$

: private{  latest @ private0 ! ;
: }private  latest @ private$ ! ;
: privatise  private0 @ 0= private$ @ 0= or if abort then
	private$ @
	begin dup private0 @ u> while
	dup (hide) @ ( → next ht ) repeat drop
	0 private0 ! 0 private$ ! ;
\ }}}

\ MMAP {{{
\ MMAP CONSTANTS {{{
hex
\ prot
0 constant PROT_NONE  1 constant PROT_READ  2 constant PROT_WRITE  4 constant PROT_EXEC
\ flags
1 constant MAP_SHARED  2 constant MAP_PRIVATE  3 constant MAP_SHARED_VALIDATE
10 constant MAP_FIXED  20 constant MAP_ANONYMOUS  100 constant MAP_GROWSDOWN
decimal
\ }}}

: mmap  9 syscall6 ;
: munmap  11 syscall2 ;
\ }}}

\ NUMERIC OUTPUT {{{
\ this buffer is also used as a temporary string buffer.
255 constant #pad
create pad 255 cells allot
: pad$  pad #pad + ;
variable hld

: <#  pad$ hld ! ;
: hold  1 hld -!  ( chr ) hld @ c! ;
: sign  0< if [ char - ] literal hold then ;
: #  base @ /mod swap 9 over < if 7 + then [ char 0 ] literal + hold ;
: #s  begin # dup 0= until ;
: #>  drop hld @ pad$ over - ;
\ }}}

\ ERRNO {{{
\ transform syscall result into [RESULT] IOR output,
\ where IOR is zero on no error and negative on an error (RESULT then being 0)
: >errno  dup 0< if 0 swap else 0 then ;
\ }}}

\ I/O {{{
0 constant stdin
1 constant stdout
2 constant stderr

: sys-write  0 syscall3 ;
: sys-read  1 syscall3 ;
: sys-open  2 syscall3 ;
: sys-close  3 syscall1 ;

: type  swap stdout sys-read drop ;
: emit  sp 1 type drop ;

0 constant r/o
1 constant w/o
2 constant r/w

: open-file  swap >r 0 r> sys-open >errno ;
: close-file  sys-close ;
: read-file  >r swap r> sys-read >errno ;
: write-file  >r swap r> sys-write >errno ;
\ }}}

bye