S" :" CREATE ] DOCOL
  READ-WORD CREATE
  LIT DOCOL ,
  ]
EXIT [

: ;
  LIT EXIT ,
  [ S" [" FIND >CFA , ]
  EXIT
[ IMMEDIATE

: IF IMMEDIATE
  ' 0BRANCH ,
  HERE @
  0 ,
;

: THEN IMMEDIATE
  DUP
  HERE @ SWAP -
  SWAP !
;

: ELSE IMMEDIATE
  ' BRANCH ,
  HERE @
  0 ,
  SWAP DUP HERE @ SWAP - SWAP !
;

: BEGIN IMMEDIATE HERE @ ;

: AGAIN IMMEDIATE ' BRANCH , HERE @ - , ;

: UNTIL IMMEDIATE ' 0BRANCH , HERE @ - , ;

: ( IMMEDIATE
  BEGIN READ-WORD 1 = IF C@ 41 = IF EXIT THEN ELSE DROP THEN AGAIN ;
( Yay! We now have  comments! )

( Compile a literal value into the current word. )
: LIT, IMMEDIATE ( x -- ) ' LIT , , ;

: / /MOD DROP ;
: MOD /MOD SWAP DROP ;
: NEG 0 SWAP - ;

( p n -- ; increment *p by n )
: INC OVER @ + SWAP ! ;

: C, HERE @ C! HERE 1 INC ;

( p -- v ; fetch 32 bit value; fetches 64 and masks the high bits )
: @32 @ 4294967295 & ;

( An alternative comment syntax. Reads until the end of the line. )
: \ IMMEDIATE BEGIN KEY 10 = UNTIL ;

( string* -- buffer length )
: S@ DUP 1 + SWAP C@ ;

( -- str* ; Put input string into dictionary heap and return address )
: "
  HERE @ 0 C, \ We will put the length here
  BEGIN KEY DUP C, 34 = UNTIL
  HERE @ 1 - 0 OVER C! OVER - OVER C!
  ;

\ So far, S" has only worked in immediate mode, which is backwards --
\ actually, the main use-case of this is as a compile-time word. Let's
\ fix that.
: S" IMMEDIATE ' LITSTRING , " DROP ;

( immediate print string, using HERE space )
: ." HERE @ " S@ TELL HERE ! ;

\ Store a null-terminated UTF-16 string HERE, and return a pointer to
\ its buffer at runtime.
: UTF16" HERE @ BEGIN KEY DUP C, 0 C, 34 = UNTIL 0 HERE @ 2 - C! ;

: NEWLINE 10 EMIT ;

: SPACE 32 EMIT ;

: .X .U SPACE ;

( RPT ... [ IFZEND ... ]* DONE )
: RPT IMMEDIATE ' BRANCH , 24 , ' BRANCH , 0 , HERE @ ;

: DONE IMMEDIATE ' BRANCH , DUP HERE @ - , 8 - HERE @ OVER - SWAP ! ;

: IFZEND IMMEDIATE ' 0BRANCH , DUP 16 - HERE @ - , ;

( v -- ; print decimal number )
: . DUP IF 10 /MOD SWAP DUP IF . ELSE DROP THEN THEN 48 + EMIT ;

( Read a number from standard input. )
: READ-NUMBER READ-WORD PARSE-NUMBER ;

( a b -- c ; logical AND wrt !=0 )
: AND IF IF 1 ELSE 0 THEN ELSE DROP 0 THEN ;

( a b -- c ; logical OR wrt !=0 )
: OR IF DROP 1 ELSE IF 1 ELSE 0 THEN THEN ;

( v [word] -- ; Declare a CONSTANT that returns a value )
: CONSTANT READ-WORD CREATE LIT DOCOL , LIT LIT , , LIT EXIT , ;

( p n -- p+n ; define name for field address of given size )
: FIELD* OVER CONSTANT + ;

( p -- p+8 ; define name for current field 64-bit value )
: FIELD@ DUP @ CONSTANT 8 + ;

( v lo hi -- v x ; x = lo <= v and v <= hi )
: RANGE 2 PICK < IF DROP 0 ELSE OVER SWAP < IF 0 ELSE 1 THEN THEN ;

\ ######## Handling hexadecimal codes: 0x...

0 1 - CONSTANT -1

( -- v ; read next character as a hexcode value or -1 )
: HEX
  KEY 48 57 RANGE IF 48 -
  ELSE 65 70 RANGE IF 55 -
  ELSE 97 102 RANGE IF 87 -
  ELSE DROP -1
  THEN THEN THEN
;

( -- v ; Read indefinite sequence of hex digits, an one character more )
: HEX* 0 RPT HEX DUP 1 + IFZEND 16 * + DONE DROP ;

( -- ; Read immediately a heax number and compile into dictionary )
: HEX, IMMEDIATE HEX* , ;

( -- v ; read next 2 characters as hexcode into a byte value )
: HEX2 HEX 16 * HEX + ;

( -- v ; read next 4 characters as hexcode into a 2-byte value )
: HEX4 HEX2 256 * HEX2 + ;

( -- v ; read next 8 characters as hexcode into a 4-byte value )
: HEX8 HEX4 65536 * HEX4 + ;

( c -- ; consume input on the line until character c or newline )
: SCANTO BEGIN KEY 10 OVER = IF DROP 1 ELSE OVER = THEN UNTIL DROP ;

( v p -- ; lay out 2-byte value as LE )
: C2! 2DUP C! SWAP 256 / SWAP 1 + C! ;

( v p -- ; lay out 4-byte value as LE )
: C4! 2DUP C2! SWAP 65536 / SWAP 2 + C2! ;

( v1..vn n -- v1..vn ; reverse the n top elements on the stack using the heap )
: REVERSE
  DUP 1 + 8 * R+ \ Allocate frame of n+1 elements (index = 1..n)
  DUP R= !       \ Save count at top
  BEGIN SWAP OVER 8 * R= + ! 1 - 1 < UNTIL DROP \ copy to return stack
  R= @           \ Restore count
  BEGIN DUP 8 * R= + @ SWAP 1 - 1 < UNTIL DROP \ copy from return stack
  R= @ 1 + 8 * R+ \ Dispose of the frame
;

( array i - array &array[i]  ; pointer into 64-bit array )
: [8] 8 * OVER + ;

( addr n -- ; TELL n bytes )
: .BYTES BEGIN SWAP DUP C@ SPACE .U 1 + SWAP 1 - DUP 0 = UNTIL DROP DROP ;

( addr n -- ; TELL n elements )
: .ELEMENTS BEGIN SWAP DUP @ SPACE .U 8 + SWAP 1 - DUP 1 < UNTIL DROP DROP ;