---

Solo Forth development history in 2015-07

2015-07-01

New: @bank and c@bank.

Fix: adapted vocabulary, forth and assembler to the new header format in memory bank:

; The dummy name field is used to create a dummy header
; in the parameter field of vocabularies, as part of the
; vocabulary chaining. It contains one space,
; so it will never be matched by `find`.
if 1 ; names_in_memory_bank?
  ; No "name bound bit" needed in this header format,
  ; just the lenght (0x01) and a space (0x20).
  dummy_name_field: equ 0x2001
else
  ; The "name bound bit" is needed in the original header format,
  ; lenght (0x01 + 0x80) and a space (0x20 + 0x80).
  dummy_name_field: equ 0xA081 ; original
endif

; ----------------------------------------------
  _colon_header vocabulary_,'VOCABULARY'

; doc{
;
; vocabulary  ( "name" -- )
;
; }doc

  ; Create a dictionary entry with the parsed name as
  ; its name, and the code field pointing to the word after
  ; `does>`.
  dw builds_ ; XXX TODO convert; see DZX-Forth

if 1 ; names_in_memory_bank?

  ;A dummy header at vocabulary intersection.
  dw current_,fetch_ ; address of the dummy lfa in the `current` vocabulary
  dw lfa_to_nfa_ ; get its correspondent nfa in the dummy header
  dw comma_ ; use it as link field of the dummy header in the new vocabulary
  dw lit_,dummy_name_field,comma_ ; name field

  dw here_ ; address of vocabulary link
  ; Fetch the user variable `voc-link` and insert it in the dictionary.
  dw voc_link_,fetch_,comma_

  dw voc_link_,store_ ; update `voc-link` with the link in this vocabulary
  dw does_ ; this is the end in defining the vocabulary

  ; The next words are to be executed when the vocabulary invoked.
do_vocabulary:
  dw context_,store_

else

  ;A dummy header at vocabulary intersection.
  dw lit_,dummy_name_field,comma_

  ; Fetch the parameter field address pointing to the last word
  ; and store its code field address in the second cell in
  ; parameter field.
  ; XXX FIXME That description is wrong; the content of
  ; `current` is an address in the pf of the vocabulary,
  ; and it seems `pfa>cfa` is used just instead of `2-`,
  ; according to the original header structure.
  ; XXX TODO fix it in _Sistems guide to fig-Forth_
  ;dw current_,fetch_,pfa_to_cfa_,comma_
  ; XXX NEW
  dw current_,fetch_,lfa_to_nfa_,comma_

  dw here_ ; address of vocabulary link

  ; Fetch the user variable `voc-link` and insert it in the dictionary.
  dw voc_link_,fetch_,comma_

  dw voc_link_,store_ ; update `voc-link` with the link in this vocabulary
  dw does_ ; this is the end in defining the vocabulary

  ; The next words are to be executed when the vocabulary invoked.
do_vocabulary:
  ; When the vocabulary is invoked, the second cell in its parameter field
  ; will be stored into the variable `context`.  The next
  ; dictionary search will begin with that vocabulary.
  dw cell_plus_,context_,store_

endif

  dw semicolon_s_

; ----------------------------------------------
  _does_header forth_,'FORTH'

  dw do_vocabulary

  ; Dummy header.
if 1 ; names_in_memory_bank?
  forth_vocabulary_dummy_lfa:
    dw nfa_of_top_most_word_in_forth_voc ; link field
  forth_vocabulary_dummy_nfa:
    dw dummy_name_field ; name field
else
  forth_vocabulary_dummy_nfa:
    dw dummy_name_field ; name field
  forth_vocabulary_dummy_lfa:
    dw nfa_of_top_most_word_in_forth_voc ; link field
endif

forth_vocabulary_link:
  dw 0x0000

; ----------------------------------------------
  _does_header assembler_,'ASSEMBLER'

  dw do_vocabulary

  ; Dummy header.
if 1 ; names_in_memory_bank?
  assembler_vocabulary_dummy_lfa:
    dw forth_vocabulary_dummy_nfa ; link field
  assembler_vocabulary_dummy_nfa:
    dw dummy_name_field ; name field
else
  assembler_vocabulary_dummy_nfa:
    dw dummy_name_field ; name field
  assembler_vocabulary_dummy_lfa:
    dw forth_vocabulary_dummy_nfa ; link field
endif

assembler_vocabulary_link:
  dw forth_vocabulary_link

One problem remained: words crashsed the system when context is other than forth and assembler. The parameter field of the created vocabularies seems right. The bug was lfa>nfa, used by vocabulary to create the parameter field of the new vocabularyes, did 2- instead of 2+.

2015-07-02

New version of does>, after Forth-83: it's paired with create instead of <builds. Conditional compilation is used, just in case. Also vocabulary, forth and assembler had to be modified:

_does_header: macro _base_label,_name,_is_immediate,_runtime_routine

  _header _base_label,_name,_is_immediate

  if 0 ; fig_does?
    dw do_does ; code field
  else
    dw _runtime_routine ; code field
  endif
  _base_label##pfa: ; parameter field address

  endm

if 0 ; fig_does?

; ----------------------------------------------
  _colon_header nfa_to_pfa_,'NFA>PFA'

  ; XXX TODO remove; only needed by the old `<BUILDS ... DOES>`

  dw nfa_to_cfa_,cfa_to_pfa_
  dw semicolon_s_

endif

if 0 ; fig_does?

; ----------------------------------------------
  _colon_header builds_,'<BUILDS'

  dw zero_,constant_
  dw semicolon_s_

; ----------------------------------------------
  _colon_header does_,'DOES>'

  dw from_r_ ; address of the first word after `does>` (the run-time routine)
  dw latest_,nfa_to_pfa_ ; pfa of the definition under construction
  dw store_ ; store the address of the run-time routine as the first parameter
  dw paren_semicolon_code_
do_does:
  ; Push the address of the next instruction on the return stack:
  ld hl,(return_stack_pointer)
  dec hl
  ld (hl),b
  dec hl
  ld (hl),c
  ld (return_stack_pointer),hl
  ; XXX TODO understand
  ; Put the address of the run-time routine in IP:
  inc de      ; de=pfa
  ex de,hl
  ld c,(hl)
  inc hl
  ld b,(hl)
  inc hl
  ; W was incremented in the last instruction, pointing to the
  ; parameter field; push it on the stack:
  jp push_hl

else ; XXX NEW -- Forth-83 version, paired with `create`

; ----------------------------------------------
  _colon_header does_,'DOES>',immediate

  ; [Code adapted from Spectrum Forth-83 and DZX-Forth.]

  dw compile_,paren_semicolon_code_
  dw c_lit_
  db 0xCD ; Z80 opcode for "call"
  dw c_comma_ ; compile it
  dw lit_,do_does ; routine address
  dw comma_ ; compile it
  dw semicolon_s_
do_does:
  ; Save the IP in the return stack.
  ld hl,(return_stack_pointer)
  dec hl
  ld (hl),b
  dec hl
  ld (hl),c
  ld (return_stack_pointer),hl
  ; Pop the address of the run-time routine
  ; (put there bye `call do_does`) in IP.
  pop bc ; new Forth IP
  ; Push the pfa.
  inc de  ; de=pfa
  push de
  ; Execute the run-time routine.
  _jp_next

endif

; ----------------------------------------------
if 0 ; fig_does?
  _does_header assembler_,'ASSEMBLER'
  dw do_vocabulary
else
  _does_header assembler_,'ASSEMBLER',,do_vocabulary
endif

  ; Dummy header.
if 1 ; names_in_memory_bank?
  assembler_vocabulary_dummy_lfa:
    dw forth_vocabulary_dummy_nfa ; link field
  assembler_vocabulary_dummy_nfa:
    dw dummy_name_field ; name field
else
  assembler_vocabulary_dummy_nfa:
    dw dummy_name_field ; name field
  assembler_vocabulary_dummy_lfa:
    dw forth_vocabulary_dummy_nfa ; link field
endif

assembler_vocabulary_link:
  dw forth_vocabulary_link

; ----------------------------------------------
  _colon_header vocabulary_,'VOCABULARY'

; doc{
;
; vocabulary  ( "name" -- )
;
; }doc

  ; Create a dictionary entry with the parsed name as
  ; its name, and the code field pointing to the word after
  ; `does>`.
if 0 ; fig_does?
  dw builds_
else
  dw create_
endif

if 1 ; names_in_memory_bank?

  ;A dummy header at vocabulary intersection.
  dw current_,fetch_ ; address of the dummy lfa in the `current` vocabulary
  dw lfa_to_nfa_ ; get its correspondent nfa in the dummy header
  dw comma_ ; use it as link field of the dummy header in the new vocabulary
  dw lit_,dummy_name_field,comma_ ; name field

  dw here_ ; address of vocabulary link
  ; Fetch the user variable `voc-link` and insert it in the dictionary.
  dw voc_link_,fetch_,comma_

  dw voc_link_,store_ ; update `voc-link` with the link in this vocabulary

  if 0 ; fig_does?
    dw does_ ; this is the end in defining the vocabulary
  do_vocabulary:
  else
    dw paren_semicolon_code_
  do_vocabulary:
    call do_does
  endif

  ; The next words are to be executed when the vocabulary is invoked.
  dw context_,store_

else

  ;A dummy header at vocabulary intersection.
  dw lit_,dummy_name_field,comma_

  ; Fetch the parameter field address pointing to the last word
  ; and store its code field address in the second cell in
  ; parameter field.
  ; XXX FIXME That description is wrong; the content of
  ; `current` is an address in the pf of the vocabulary,
  ; and it seems `pfa>cfa` is used just instead of `2-`,
  ; according to the original header structure.
  ; XXX TODO fix it in _Sistems guide to fig-Forth_
  ;dw current_,fetch_,pfa_to_cfa_,comma_
  ; XXX NEW
  dw current_,fetch_,lfa_to_nfa_,comma_

  dw here_ ; address of vocabulary link

  ; Fetch the user variable `voc-link` and insert it in the dictionary.
  dw voc_link_,fetch_,comma_
  dw voc_link_,store_ ; update `voc-link` with the link in this vocabulary

  if 0 ; fig_does?
    dw does_ ; this is the end in defining the vocabulary
  do_vocabulary:
  else
    dw paren_semicolon_code_
  do_vocabulary:
    call do_does
  endif

  ; The next words are to be executed when the vocabulary is invoked.
  ; When the vocabulary is invoked, the second cell in its parameter field
  ; will be stored into the variable `context`.  The next
  ; dictionary search will begin with that vocabulary.
  dw cell_plus_,context_,store_

endif

  dw semicolon_s_

; ----------------------------------------------

if 0 ; fig_does?
  _does_header forth_,'FORTH'
  dw do_vocabulary
else
  _does_header forth_,'FORTH',,do_vocabulary
endif

  ; Dummy header.
if 1 ; names_in_memory_bank?
  forth_vocabulary_dummy_lfa:
    dw nfa_of_top_most_word_in_forth_voc ; link field
  forth_vocabulary_dummy_nfa:
    dw dummy_name_field ; name field
else
  forth_vocabulary_dummy_nfa:
    dw dummy_name_field ; name field
  forth_vocabulary_dummy_lfa:
    dw nfa_of_top_most_word_in_forth_voc ; link field
endif

forth_vocabulary_link:
  dw 0x0000

2015-07-04

Adapted the whole defer family from the Afera library.

( defer defer@ defer! defers action-of )

  \ [Code adapted from the Afera library.]

: (defer)  ( -- )
  \ Default behaviour of an uninitialized deferred word: error.
  15 error ;

: defer  ( "name" -- )
  \ Create a deferred word.
  postpone : postpone (defer) postpone ;  ;

: defer@  ( cfa1 -- cfa2 )
  \ Return the cfa of the word currently associated with a deferred word.
  \ cfa1 = cfa of the deferred word
  \ cfa2 = cfa of the word it's associated with
  cfa>pfa @  ;

: defer!  ( cfa1 cfa2 -- )  cfa>pfa !  ;

: defers  ( "name" -- )
  \ Compile the present contents of the deferred word "name"
  \ into the current definition. I.e. this produces static
  \ binding as if "name" was not deferred.
  ' defer@ ,  ; immediate

: action-of  ( Interpretation: "name" -- cfa )
             ( Compilation:    "name" -- )
             ( Runtime:        -- cfa )
  \ Return the code field address of a deferred word.
  ' comp? if    postpone literal postpone defer@
          else  defer@  then  ; immediate

( <is> [is] is  )

  \ [Code adapted from the Afera library.]

: <is>  ( cfa "name" -- )  ' defer!  ;

: [is]  ( cfa "name" -- )
  ' postpone literal postpone defer!  ; immediate

: is  ( cfa "name" -- )
  comp? if  postpone [is]  else  <is>  then  ; immediate

New: um* (code from DZX-Forth) substitutes the fig-Forth u*. They do the same.

New: random number generator:

( seed rnd random randomize )

  \ [Code adapted from Leo Brodie's code and Gforth.]

23672 constant seed  \ address of system variable

: rnd  ( -- n )  seed @ 31421 * 6927 + dup seed !  ;

: random  ( n -- 0..n-1 )  rnd um* nip  ;

: randomize  ( n -- )  seed !  ;

First changes to let several while into the begin structure.

Fix: plot called a wrong address in the PLOT-SUB ROM routine.

Copied the assembler from the Afera library, a fig-Forth version for Abersoft Forth, with some changes, of the original assembler designed by Coos Haak and included in Lennart Benschop's Spectrum Forth-83.

2015-07-05

Converted the assembler from fig-Forth to Solo Forth.

2015-07-06

Reorganized the library disk. New word in the control structures section:

code j'  ( R: n x -- n x ) ( -- n )

  \ Return the limit of the outer `DO`-`LOOP` structure.

  2A c, rp ,        \ ld hl,(return_stack_pointer)
  11 c, 0006 ,      \ ld de,6
  19 c,             \ add hl,de
  C3 c, fetchhl ,   \ jp fetchhl

  end-code

fetchhl is a new constant that holds the address of an entry point into the inner interpreter, common to several words.

Implemented the for step, adapted from Z88 CamelForth.

( for step )

  \ Credits:
  \ Code adapted from Z88 CamelForth. Modified to do the check
  \ before decrementing the index.

code (step)  ( R: n -- n' )

  \ doc{
  \
  \ (step)
  \
  \ The run-time procedure compiled by `step`.
  \
  \ Run-time:    ( R: u -- u' )
  \
  \ If the loop index is zero, discard the loop parameters and
  \ continue execution after the loop. Otherwise decrement the
  \ loop index and continue execution at the beginning of the
  \ loop.
  \
  \ }doc

  2A c, rp ,
    \ ld hl,(return_stack_pointer)
  5E c, 23 c, 56 c,
    \ ld e,(hl)
    \ inc hl
    \ ld d,(hl) ; de = loop index
  7A c, B3 c,
    \ ld a,d
    \ or e ; z=already zero?
  1B c, 72 c, 2B c, 73 c,
    \ dec de
    \ ld (hl),d
    \ dec hl
    \ ld (hl),e ; update the loop index
  C2 c, ' branch cfa>pfa ,
    \ jp nz,branch_pfa ; loop again if not zero
    \ ; done, discard loop index:
  23 c, 23 c, 22 c, rp ,
    \ inc hl
    \ inc hl
    \ ld (return_stack_pointer),hl
    \ ; skip branch offset and jump to next
  03 c, 03 c, jpnext
    \ inc bc
    \ inc bc
    \ jp next

  end-code

: for  ( n -- )  postpone >r <mark  ; immediate

  \ doc{
  \
  \ for  Compilation: ( R: -- dest ) Run-time:    ( u -- )
  \
  \ Start of a `for step` loop, that will iterate _u+1_ times,
  \ starting with _u_ and ending with 0.
  \
  \ The current value of the index can be retrieved with `i`.a
  \
  \ }doc

: step  ( -- )  postpone (step) <resolve  ; immediate

  \ doc{
  \
  \ step
  \
  \ Compilation: ( dest -- )
  \
  \ Append the run-time semantics given below to the current
  \ definition. Resolve the destination of `for`.
  \
  \ Run-time:    ( R: u -- u' )
  \
  \ If the loop index is zero, discard the loop parameters and
  \ continue execution after the loop. Otherwise decrement the
  \ loop index and continue execution at the beginning of the
  \ loop.
  \
  \ }doc

2015-07-11

New: error>line, called by error. Now also error numbers 16, 32, 48... can be used. So far they were omitted because they are header screen lines in the library, and the fsb converter needs all screen headers to be marked as such, with parens.

  _colon_header error_to_line_,'ERROR>LINE'

; doc{
;
; error>line  ( n1 -- n2 )
;
; Convert an error number to its correspondent line offset. This
; is used in order to skip the first line of screens and use
; them as screen headers as usual.
;
; }doc

  dw dup_,zero_,paren_do_
  dw i_
  dw c_lit_
  db 16
  dw mod_,zero_equals_,plus_,paren_loop_
  dw semicolon_s_

A single calculation would be better than a loop, but so far I failed coding it. Anyway, the word will be adapted when the value of true is changed from 1 to -1.

2015-07-16

Started adapting the transient[ tool from Afera.

2015-07-17

New: !bank and c!bank; four words to fetch from and store into the names bank; and cfap>lfa, required by the planned implementation of transient[ and ]transient.

Renamed time@, time! and time0 to frames@, frames! and frames0.

Started documenting the control structures of the assembler. Renamed tst as tstp. Changed control structures to use >mark, >resolve, <mark, <resolve and the new words >relmark and >relresolve.

2015-07-20

Copied the address register tool from Z88 CamelForth and start adapting the defining words.

2015-07-21

Adapted the address register assembler code from Z88 CamelForth by Gary Lancaster. Not tested yet.

Fixed error>line: the loop branch was missing.

Change every [compile] in the library to postpone.

Renamed (required) as do-required. New: do-require.

Fixes in the assembler: the hex number DE, used to define an opcode, was mistaken as the de register. 0DE is used instead; a variable definition still had its init value from fig-Forth. Check: the assembler occupies 1565 bytes.

2015-07-22

Changed the behaviour of ?terminal: it does not check the Edit key anymore, just the Break key.

Changed the behaviour of sp! and rp!, after Gforth and other systems: now they use the value on the stack. That is more useful than the original behaviour in fig-Forth.

Reorganized the user variables to make room for 8 vocabularies in `context`, in order to implement the search order after F83.

Made the names memory bank option definitive. The old code is removed.

find needs to be rewritten. The current version, adapted from fig-Forth, searches context and current:

  _colon_header find_,'FIND'

; doc{
;
; find  ( ca --- ca 0 | cfa 1 | cfa -1 )
;
; }doc

  dw trail_ ; try with the `context` vocabulary
  dw paren_find_
  dw question_dup_ ; not found?
  dw question_branch_,find.end
  ; not found, try with the `current` vocabulary
  dw latest_,paren_find_

find.end:
  dw semicolon_s_

The new version uses the search order, the vocabularies hold by context:

  _colon_header find_,'FIND'

; doc{
;
; find  ( ca --- ca 0 | cfa 1 | cfa -1 )
;
; Find the definition named in the counted string at _ca_. If
; the definition is not found after searching all the
; vocabularies in the search order, return _ca_ and zero.  If
; the definition is found, return its _cfa_. If the definition
; is immediate, also return one (1); otherwise also return
; minus-one (-1).
;
; }doc

  ; : find  ( ca --- ca 0 | cfa 1 | cfa -1 )
  ;   #vocs 0 do
  ;     context i cells + @  ?dup
  ;     if  @ (find) ?dup if  unloop exit  then  then
  ;   loop  false  ;

  dw hash_vocs_,zero_,paren_do_
find.do:
  dw context_,i_,cells_,plus_,fetch_
  dw question_dup_ ; a vocabulary in the search order?
  dw zero_branch_,find.loop ; if not, next
  ; valid vocabulary in the search order
  dw fetch_,paren_find_,question_dup_ ; word found in the vocabulary?
  dw zero_branch_,find.loop ; if not, try the next vocabulary
  dw unloop_,exit_
find.loop:
  dw paren_loop_,find.do,false_
  dw semicolon_s_

• Renamed leave to exhaust (though the planned ANS Forth version of leave is not defined yet). Added ?exhaust.

The implementation of the search order words (adapted from F83) almost works... Still some problems.

Made it possible to load the words of the address register tool apart.

2015-07-23

Removed the old version of .", that used word, and deprecated a long time ago.

Started moving the search words from the library into the kernel.

Fixed words: it crashed the system when there was no word in the context vocabulary. This problem didn't existed in the original fig-Forth code, because of the chained vocabularies.

  _colon_header words_,'WORDS'

  dw trail_,question_dup_,zero_equals_ ; no word?
  dw question_exit_ ; if so, exit
  dw c_lit_
  db 0x80
  dw out_,store_
words.begin: ; ( nfa )
  dw out_,fetch_
  dw c_lit_
  db max_word_length-8
  dw greater_than_
  dw zero_branch_,words.continue
  dw cr_
words.continue: ; ( nfa )
  dw dup_,id_dot_ ; print word
  dw nfa_to_lfa_
  dw fetch_n_
  dw dup_,zero_equals_,question_terminal_,or_
  dw zero_branch_,words.begin ; until
  dw drop_
  dw semicolon_s_

Anyway, the fixed version is removed from the kernel. There's an alternative simpler version in the library disk, that produces a cleaner printout:

( words )

  \ [Code adapted from Spectrum Forth-83.]

[defined] tab ?\  : tab  ( -- )  6 emit  ;

: words  ( -- )
  trail
  begin  dup 0<> ?terminal 0= and  while
    dup id. tab  nfa>lfa @n
  repeat drop ;

Moved list from the kernel to the library disk.

( list )

: list  ( n -- )

  \ List screen number _n_.

  dup scr !
  cr ." Scr # " .
  l/scr 0 do
    cr i 2 .r space i scr @ .line
    ?terminal if  exhaust  then
  loop cr  ;

Eventually all tool words will be moved to the library disk, because Solo Forth is meant for cross-development.

Added next,, pushhl,, pushde, and fetchhl, to the assembler vocabulary in the kernel. Moved next, pushhl, pushde and fetchhl to it. This way defining code words in the library is a bit easier without loading the full assembler.

Added compile,; in Solo Forth it just executes ,, but makes some definitions clearer and the code more portable.

Moved asm and end-code to the assembler vocabulary.

Fixed decode: clit was not included in the recognized special cases:

( decode -- special cases )

: decode-compile    ( a1 -- a2 )  2+ dup @ 2+ pfa>nfa id.  ;

: decode-literal    ( a1 -- a2 )  2+ dup @ .  ;

: decode-cliteral   ( a1 -- a2 )  2+ dup c@ . 1-  ;

: decode-branch     ( a1 -- a2 )  2+ dup @ u.  ;

: decode-dot-quote  ( a1 -- a2 )
  2+ dup count type  dup c@ + 1 -  ;

-->

( decode -- special cases dispatcher )

: decode-special  ( a1 -- a1 | a2 )
  dup @
  case
    ['] compile   of  decode-compile    endof
    ['] lit       of  decode-literal    endof
    ['] clit      of  decode-cliteral   endof
    ['] branch    of  decode-branch     endof
    ['] 0branch   of  decode-branch     endof
    ['] ?branch   of  decode-branch     endof
    ['] (loop)    of  decode-branch     endof
    ['] (+loop)   of  decode-branch     endof
    ['] (.")      of  decode-dot-quote  endof
  endcase  ;
-->

Changed word to return a string address, after ANS Forth. This way the returned string could be packed in the circular string buffer. Anyway, eventually parse-word will be used instead.

New: parsed, a factor of parse and parse-word in the kernel: : parsed ( len -- ) 1+ >in +! ;.

Renamed string-allocate to allocate-string and csb-unused to unused-csb. The prefix+action format is less clear and less usual.

2015-07-24

Renamed parse-word to parse-name, after Forth-2012.