Solo Forth development history in 2015-06
Description of the page content
Solo Forth development history in 2015-06.
2015-06-02
Start, based on the disassembled code of Abersoft Forth.
First changes:
Some fig-Forth words are renamed with their modern forms: vlist as words, -dup as ?dup, minus as negate, dminus as dnegate, s->d as s>d, mon as bye, free as unused.
Old synonyms are removed: end and endif.
The editor is removed.
branch and back are modified to do absolute branches. The branches are converted with a simple substitution, thanks to the comments prepared by the disassembling of Abersoft Forth.
New words, from the Afera library: \, .(, char and [char], 2-, 1-, 2*.
2+ and 1+ are converted to Z80.
forth is not immediate any more.
' is converted to non-immediate; new immediate version: ['].
2015-06-03
dliteral is renamed as 2literal.
Removed: verify.
2015-06-04
New: upperc and uppers.
Improvement: -find is made case insensitive.
key is documented.
Removed: udg, init-disc, .cpu.
New: <>.
Improvement: the lower part of the screen can be used.
Removed: loadt, savet, (tape) and tape headers.
Removed: triad.
Change: inp renamed as p@; outp renamed as p!.
Change: stacks and buffers are moved to the bottom of the memory map, before the interpreter. They must be below 0xC000 in order to use the memory banks.
Change: r renamed as r@; the Z80 code of i is moved to r@, and the cfa of i is pointed to the pfa of r@. This is logical and faster (formerly r was a colon word that called i).
New: clit and cliteral. Their code ocuppies 46 bytes, but there are 84 compiled bytes that save one byte when using clit instead of lit, and it's faster.
Change: bleep is moved to the blocks disk.
Improvement: quit is optimized: faster and smaller.
New: bounds; used in type.
Removed: not (synonym of 0=).
Change: offset deactivated.
New: block>sector and first tries with the new version of r/w, that uses the sectors of the disk. The screens can be listed, but only the first time. They are shown corrupted when trying to access them more than once. Something is wrong.
New: plotted?, with the code of Afera's point.
New: [if] [else] [then], from Afera. They still need changes.
New: copied require and its related words from lina ciforth and started adapted them.
2015-06-05
New: nip, tuck.
Improvement: 2drop rewritten in Z80.
New: rdrop, in Z80 (exit is pointed to it); 2rdrop and unloop.
Removed: plot (faster version, from Afera, added to the blocks disk); draw (faster version will be create).
Improvement: Error messages are included in screens 4 and 5 of the blocks disk. In order to avoid numbers 0 and 16 (that coincide with the first lines of screens 4 and 5, and are incompatible with the fsb format), some error messages are reorganized (and updated in the main source).
New: -rot in the blocks disk.
New: recurse.
Change: pfa is renamed as nfa>pfa; the rest of the family is renamed with the prefix "pfa>". This is a first step before reorganizing the headers to make them faster, probably moving the lfa before the nfa, and also modifying ' and ['] to return the cfa instead of the pfa.
Fix: there was an old relative branch calculation in then.
Fix: cliteral, recently implemented, used comma!
Fix: +buf used clit for the new b/buf 4 +, that is greater than 0xFF! Now the blocks in disk work fine.
Change: The first six user variables, unused, are moved to the end of the space. All the related pointers are apdated. Conditional compilation is used, just in case. The final goal is to reorganize the parameter area, removing all unnecessary fig-Forth stuff.
Change: Entry points are moved to the start (new origin).
New: Copied decode from Afera. First changes to adapt it.
2015-06-06
New: msg-scr, idea from lina ciforth, useful to customize the organization of the screens on disk.
2015-06-07
Change: faster and smaller versions of ink and paper, from the Afera library. This saves 264 bytes!
New: constants true and false; primitives on and off.
Change: conditional compilation flag to free the IX register, originally used as the user variables pointer, in order to hold next. This way jumps to next are faster and save one byte per jump (52 bytes saved).
Change: user_variables_pointer_init_value is removed. The fig-Forth model uses it in cold, but it's not needed because the memory map is not calculated during the cold start. In fact it is not used by Abersoft Forth.
Fix: The new version of at, taken from Spectrum Forth-83, had a copying mistake, a missing dup.
New: continued, as a factor of load.
Change: optimizations in the definitions, thanks to the new words: 1- instead of 1 minus, 2- instead of 2 -. Also 2dup instead of over over, an oversight of Abersoft Forth.
Improvement: Some operators are (re)written, using Z80 code from DZX-Forth.
2015-06-08
Improvement: faster blanks and erase, with Z80 jumps into fill.
Improvement: the branches of x (the null word) are optimized.
Improvement: one branch removed from ." (2 bytes less, and faster in compiling mode).
Change: Now ' and ['] return the cfa, not the pfa.
New: cfa>pfa, cfa>lfa, cfa>nfa (pfa>nfa and pfa>lfa could be removed).
Change: forget is updated to the new behaviour of ' and moved to the blocks file; also the code in the blocks file is updated.
2015-06-09
Change: flash, bright, gover and inverse are moved to the disk.
Problem detected with (emit) and those four booleans attributes.
New: pick, from DZX-Forth.
Change: The original system to print out with link wasn't practical, because it copied to the printer everything that was printed on the screen. It is removed. Now the new words printer and display are used instead.
2015-06-10
Changes in (emit), in order to fix the problems with boolean attributes. It seems the channel must be opened every time; or the temporary attributes must be set. Finally, all color words are written in Z80, in the kernel, sharing one main routine: printing the chars required to set the temporary attribute, and then calling the ROM routine that makes it permanent. This method works for all attributes and print flags. Example:
paper_nfa:
db 0x05+0x80,'PAPE','R'+0x80
paper_lfa:
dw bright_nfa
paper_:
dw paper_pfa
paper_pfa:
ld a,paper_char
jp color
ink_nfa:
db 0x03+0x80,'IN','K'+0x80
ink_lfa:
dw paper_nfa
ink_:
dw ink_pfa
ink_pfa:
ld a,ink_char
color:
; Set a color attribute (ink, paper, bright, flash, inverse or gover).
; a = attribute control char
; (tos) = color attribute value
rst 0x10
pop hl
ld a,l
rst 0x10
call rom_set_permanent_colors_0x1CAD
_jp_next
The color words are removed from the blocks disk.
Improvement: smaller and faster ?terminal.
Change: the use of the IX register to hold the address of next is made definitive. The conditional compilation for the old method is removed.
Improvement: when the IX register must be preserved because of ROM calls, now ld ix,next is used instead of push ix and pop ix; it's faster and easier, and uses the same memory (4 bytes).
New: ms, time@, time! and time0, copied from Afera.
2015-06-11
The parameters of enclose have been exchanged. This saves a swap in word.
New: pixel-add Z80 routine in the library disk.
Improvement: plot and plotted? use the whole screen.
2015-06-13
The parsing bug has been found. The problem is enclose use an 8-bit register as offset counter. It can not be used to scan a 512-byte buffer. The code has been rewritten to use a pair register as offset counter.
There's a second bug: something fails when the parsing of the screen passes from the first to the second disk block.
Some experimental changes to the null word, with simpler and faster flow.
2015-06-17
Modification in expect; the code that manages the delete key wasted some bytes.
Fix: on and off changed only the first part of the value! That was the reason the second block of screens was not parsed: in was not properly set to zero in the null word.
Improvement: One byte saved in id..
Fix: typo in number in pixel. Now the new point and plot work with Y coordinate range 0..191.
New: the strings module of the Afera library is included in the disk.
New: code (based on create, that will be rewritten), end-code, assembler (empty vocabulary).
New: [defined], [undefined], ?--> and ?\ are included in the kernel, copied from the Afera library. They are essential to manage the disk screens.
Improvement: 2swap is rewritten is Z80, copying the code from DZX-Forth.
Change: size is moved to the disk. It's needed only by system.
Change: -find is renamed as find, and factored out with context-find, in order to implement defined?, needed by required.
Change: i' is moved to the disk.
New: rp, required to rewrite i' outside the kernel.
New: [true] and [false], fram Afera.
2015-06-18
Improvement: Macros are used to create the headers.
Fix: ?exit.
Improvement: faster and smaller 2@ and 2over, do_two_constant.
if 0 ; XXX OLD -- From Abersoft Forth
inc hl ; T06 1
inc hl ; T06 1 ; high part
ld e,(hl) ; T07 1
inc hl ; T06 1
ld d,(hl) ; T07 1
push de ; T11 1
dec hl ; T06 1
dec hl ; T06 1
ld d,(hl) ; T07 1
dec hl ; T06 1
ld e,(hl) ; T07 1
push de ; T11 1
_jp_next ; T08 2
;T104 14 TOTAL
else ; XXX NEW -- From DZX-Forth
ld e,(hl) ; T07 1
inc hl ; T06 1
ld d,(hl) ; T07 1
inc hl ; T06 1
ld a,(hl) ; T07 1
inc hl ; T06 1
ld h,(hl) ; T07 1
ld l,a ; T04 1
ex de,hl ; T04 1
jp pushde ; T10 3
; T11 0 push de
; T11 0 push hl
; T86 12 TOTAL
; Faster and shorter than the code of C/PM fig-Forth 1.1g
; (T94 14):
if 0
EXX ; T04 1 ; save IP
POP HL ; T10 1 ; addr
LD C,(HL) ; T07 1
INC HL ; T06 1
LD B,(HL) ; T07 1 ; dH
INC HL ; T06 1
LD E,(HL) ; T07 1
INC HL ; T06 1
LD D,(HL) ; T07 1 ; dL
PUSH DE ; T11 1 ; (S2)<--dL
PUSH BC ; T11 1 ; (S1)<--dH
EXX ; T04 1 ; restore IP
_jp_next ; T08 2 ; jp (ix)
; T94 14
endif
New: 2r@.
Change: First changes to modify the format of the name field, removing the end bit of the last char. The new format will make some things easier.
Change: dr0 removed.
Improvement: nip used in / and */.
2015-06-19
Improvement: The new format of name fields is finished and working. The old format can be selected with conditional compilation, just in case, until the system is fully tested.
Some things, like id., are simpler now:
_colon_header id_dot_,'ID','.'
if fig_name_field?
dw pad_
dw c_lit_
db max_word_length+1
dw c_lit_
db 0x5F ; XXX why this char?
dw fill_
dw dup_,nfa_to_lfa_,over_ ; ( nfa lfa nfa )
dw minus_ ; ( nfa len+1 )
dw pad_,swap_,cmove_
dw pad_,count_ ; ( pad len+name_bound_bit_mask+n )
dw c_lit_
db max_word_length
dw and_ ; ( pad len )
dw two_dup_,plus_,one_minus_ ; address of the last char ( pad len pad+len-1 )
if 0 ; XXX OLD
dw dup_,fetch_
dw lit_,0xFF7F,and_
dw swap_,store_
else ; XXX NEW
dw dup_,c_fetch_
dw c_lit_
db 0x7F
dw and_,swap_,c_store_
endif
dw type_,space_
dw semicolon_s_
else ; XXX NEW -- name field without end bit in the last char
dw count_
dw c_lit_
db max_word_length_bit_mask
dw and_
dw type_,space_
dw semicolon_s_
endif
The main change is (find):
_code_header paren_find_,'(FIND',')'
; (FIND) ( ca nfa --- pfa b tf | ff )
if fig_name_field?
; XXX TODO optimize speed with absolute jumps?
; XXX TODO -- return cfa instead of pfa
; XXX TODO -- always return two elements, after Forth-94
pop de ; nfa
paren_find.begin:
; (sp) = string address
; de = nfa
pop hl ; string address
push hl ; save for next iteration
ld a,(de) ; length byte
xor (hl) ; filter deviations
and 0x3F ; mask msb and precedence bit
jr nz,paren_find.skip_name_field ; lengths differ
paren_find.compare_next_char:
inc hl ; next character in string
inc de ; next character in name field
ld a,(de)
xor (hl) ; filter deviations
add a,a
jr nz,paren_find.not_a_match ; no match
jr nc,paren_find.compare_next_char ; match so far, loop again
; The string matches.
; de = address of the last char of the name field
ld hl,0x0005 ; offset from lfa-1 to pfa
add hl,de
ex (sp),hl ; pfa to stack
paren_find.search_for_length_byte:
dec de ; position de on nfa
ld a,(de)
or a ; msb=1?; if so, length byte
jp p,paren_find.search_for_length_byte ; no, try next char
ld e,a ; length byte
ld d,0x00
ld hl,true
jp pushde ; name field found, return
paren_find.not_a_match:
; Above name field not a match, try next one
jr c,paren_find.name_field_skipped ; carry = end of name field
paren_find.skip_name_field:
; Find end of name field
inc de
ld a,(de)
or a ; msb=1?
jp p,paren_find.skip_name_field ; no, loop
paren_find.name_field_skipped:
inc de ; lfa
ex de,hl
ld e,(hl)
inc hl
ld d,(hl)
ld a,d
or e ; end of dictionary?
jp nz,paren_find.begin ; if not, continue
; No match found, return
pop hl ; drop string address
jp false_pfa
else
ld (ip_backup),bc ; save Forth IP
pop de ; nfa
pop hl ; string address
ld (paren_find.string_address),hl
paren_find.begin:
; Compare the string with a new word.
; de = nfa
ld (paren_find.nfa_backup),de ; save for later
paren_find.string_address: equ $+1
ld hl,0 ; string address
ld a,(de) ; name field length byte
ld c,a ; save for later
and max_word_length_bit_mask ; actual length
cp (hl)
jr nz,paren_find.not_a_match ; lengths differ
; Lengths match.
ld a,c ; name field length byte
and max_word_length_bit_mask ; actual length
ld b,a
paren_find.compare_next_char:
inc hl ; next character in string
inc de ; next character in name field
ld a,(de)
cp (hl)
jr nz,paren_find.not_a_match ; no match
djnz paren_find.compare_next_char ; match so far, loop again
; The string matches.
; de = address of the last char of the name field
; c = name field length byte
ld hl,5 ; offset from lfa-1 to pfa
add hl,de
push hl ; pfa
ld e,c ; length byte
ld d,0
ld hl,true
ld bc,(ip_backup) ; restore Forth IP
jp pushde
paren_find.not_a_match:
; Not a match, try next one.
paren_find.nfa_backup: equ $+1
ld hl,0 ; nfa
ld a,c ; length byte
and max_word_length_bit_mask ; actual length
ld c,a ; actual length
inc c ; plus the length byte
ld b,0
add hl,bc ; hl = lfa
ld e,(hl)
inc hl
ld d,(hl)
ld a,d
or e ; end of dictionary?
jp nz,paren_find.begin ; if not, continue
; No match found, return.
ld bc,(ip_backup) ; restore Forth IP
jp false_pfa
endif
Change: The new word header substitutes create. create is changed after Forth-94. Its role in fig-Forth was already taken by code.
Change: First steps to implement a modern version of find, after
Fix: message had a strange condition, from Abersoft Forth, to prevent from printing message number zero when warning is on.
Added ?branch to decode. Solo Forth uses both 0branch (branch if zero) and ?branch (branch if not zero).
2015-06-20
The new version of find, rewritten after Forth-83 and Forth-94, seems to work fine. Also the new version of the name field works fine. Conditional compilation is used for both changes, just in case.
New: error does not push the values of blk and in, but stores them in a new double variable called error-pos. where fetchs them from there. This is cleaner and more flexible, because the last error position can be shown any time.
New: label, a define word that returns the address of its pfa, like a variable, but stores nothing into it. Useful to create machine code routines or data buffers.
New: nfa>string, adapted from DZX-Forth. It was a natural factor of the new version of id..
Improvement: error saves the error number into the new variable error#.
Change: slit, sliteral, s, and s" are moved from the disk to the kernel. Basic string support is needed to manage the disk screens (require, locate, compare and others).
New: scr/disk constant, screens per disk. It will be needed to compile a variant for +3DOS, or to use disk drives of different sizes.
New: cells, cell and cell+.
New: set of hex numbers printing words, adapted from lina.
2015-06-21
compare is finished. Some changes were necessary in the code of DZX-Forth.
; ----------------------------------------------
_code_header compare_,'COMPAR','E'
; Adapted from DZX-Forth.
pop de ; de = len2
pop hl ; hl = ca2
ex (sp),hl ; hl = len1 ; ( ca1 ca2 )
ld a,d
cp h
jr nz,compare.lengths
ld a,e
cp l
compare.lengths:
; cy = string2 is longer than string1?
jr c,compare.ready
ex de,hl
compare.ready:
; de = length of the short string
; hl = length of the long string
ld l,c
ld h,b ; hl = Forth IP
pop bc ; bc = ca2
ex (sp),hl ; hl = ca1 ; save Forth IP
push af ; save carry flag
compare_.compare_strings: equ $+1 ; XXX not used yet
call compare_strings_case_sensitive
;jr z,compare.match
jr nz,compare.no_match
compare.match:
; The smaller string matches.
pop af ; restore flags
jr compare.end
compare.no_match:
; The smaller string does not match.
pop bc ; useless carry flag
compare.end:
pop bc ; restore Forth IP
ld hl,1
jp c,pushhl
dec hl ; 0
jp z,pushhl ; string1 equals string2
dec hl ; -1
jp pushhl
compare_strings_case_sensitive:
; Copied from DZX-Forth.
; Used by 'compare' and 'search'.
; Input:
; HL = a1
; BC = a2
; DE = len
; Output:
; Z = match?
ld a,e
or d
ret z
ld a,(bc)
cp (hl)
ret nz
inc hl
inc bc
dec de
jp compare_strings_case_sensitive
New: <mark, <resolve, >mark and >resolve,, after Forth-83. <resolve substitutes fig-Forth's back. With this words, the code of control structures is clearer, more legible, and it's easier to implement new ones.
Change: A bit simpler and faster endcase.
Change: cswap is renamed as flip, after eForth; upperc is renamed as upper.
New: :noname, copied from the Afera library.
New: search, adapted from DZX-Forth.
Change: count is rewritten in Z80, faster and smaller (using the end of clit to push the result).
2015-06-22
Improvement: faster and smaller > and <, using code from DZX-Forth. New: 0>, based on the same code.
_code_header zero_greater_than_,'0','>'
pop de
ld hl,0
jp is_de_less_than_hl
_code_header greater_than_,'','>'
pop hl
pop de
jp is_de_less_than_hl
_code_header less_than_,'','<'
if 1 ; XXX NEW -- from DZX-Forth
pop de
pop hl
is_de_less_than_hl:
call compare_de_hl_signed
if size_optimization?
jp true_if_cy
else
jp c,true_pfa
jp false_pfa
endif
else ; XXX OLD
pop de ; n2
pop hl ; n1
ld a,d
xor h ; one of them negative?
jp m,less_than.wich_negative ; if so, determine which
; no one is negative
and a ; clear carry
sbc hl,de
less_than.wich_negative:
if 0 ; XXX OLD
; Original version from Abersoft Forth, badly optimized
; because of the two 'ld hl' and two `jp push_hl`.
inc h
dec h ; h negative?
jp m,less_than.true
ld hl,false
jp push_hl
less_than.true:
ld hl,true
jp push_hl
else ; XXX NEW
; Version from CP/M fig-Forth 1.1g,
; with additional improvement for speed:
; bit 7,h ; h negative?
; ld hl,false
; jp z,push_hl
; inc l ; true ; XXX TODO -- change to `dec hl` when true=-1
; jp push_hl
; Optimized for space:
bit 7,h ; h negative?
jp z,false_pfa
jp true_pfa
endif
endif
Faster and smaller version of u<, in Z80; the correspondent u> is added.
; ----------------------------------------------
_code_header 'U','>'
pop hl
u_greater_than.hl:
pop de
jp u_less_than.de_hl
; ----------------------------------------------
if 0 ; XXX OLD -- original
_colon_header u_less_than_,'U','<'
dw two_dup_
dw xor_
dw zero_less_than_
dw zero_branch_,branch_destination_0x6585
dw drop_
dw zero_less_than_
dw zero_equals_
dw branch_,u_less_than_.end
branch_destination_0x6585:
dw minus_
dw zero_less_than_
u_less_than_.end:
dw semicolon_s_
else
_code_header u_less_than_,'U','<'
pop de
pop hl
u_less_than.de_hl:
call compare_de_hl_unsigned
if size_optimization?
jp true_if_cy
else
jp c,true_pfa
jp false_pfa
endif
endif
New: emits, converted from eForth; spaces is rewritten to use it.
line is removed; it was a rest from the editor.
Faster and smaller lfa>nfa:
if 0 ; XXX OLD
_colon_header lfa_to_nfa_,'LFA>NF','A'
lfa_to_nfa.begin:
dw one_minus_,dup_,c_fetch_ ; ( a c )
dw c_lit_
db name_bound_bit_mask
dw and_
dw zero_branch_,lfa_to_nfa.begin ; until
dw semicolon_s_
else ; XXX NEW
_code_header lfa_to_nfa_,'LFA>NF','A'
pop hl
lfa_to_nfa.do:
dec hl
bit name_bound_bit,(hl)
jp z,lfa_to_nfa.do:
jp push_hl
endif
Improvement: simpler and faster version of the null word.
_colon_header x_,'',0,immediate
if 0 ; XXX OLD -- original version
dw blk_,fetch_ ; input stream from disk?
dw zero_branch_,x.from_terminal
; From disk.
dw one_,blk_,plus_store_ ; next disk buffer
dw in_,off_ ; clear `in`, preparing parsing of input text
dw blk_,fetch_,b_slash_scr_,one_minus_,and_,zero_equals_ ; last buffer?
dw zero_branch_,x.end
; The last buffer, the end of the text block.
dw question_exec_ ; error if not executing
; Discard the address of `?stack` after `execute` in the interpretation loop.
dw from_r_,drop_
dw branch_,x.end
x.from_terminal:
dw from_r_,drop_
x.end:
dw semicolon_s_
else ; XXX NEW -- simpler and faster flow
dw blk_,fetch_ ; input stream from disk?
dw zero_branch_,x.exit ; if not, branch
; From disk.
dw one_,blk_,plus_store_ ; next disk buffer
dw in_,off_ ; clear `in`, preparing parsing of input text
; Note: This check of the last block is specific for 2 blocks per screen;
; the generic slower check would be `blk @ b/scr 1- and`.
dw blk_,fetch_,one_,and_ ; was it the last block of the screen?
dw question_branch_,x.end ; if not, branch
; Last block of the screen.
dw question_exec_ ; error if not executing
x.exit:
dw r_drop_
x.end:
dw semicolon_s_
endif
New smaller and faster versions of min and max, in Z80. New: umin and umax. All of them are adapted from DZX-Forth:
; ----------------------------------------------
_code_header umax_,'UMA','X'
; umax ( u1 u2 -- u1 | u2 )
pop de
pop hl
call compare_de_hl_unsigned
jp max.1
; ----------------------------------------------
_code_header umin_,'UMI','N'
; umin ( u1 u2 -- u1 | u2 )
pop de
pop hl
call compare_de_hl_unsigned
jp max.2
; ----------------------------------------------
if 0 ; XXX OLD
_colon_header min_,'MI','N'
dw two_dup_
dw greater_than_
dw zero_branch_,min.end
dw swap_
min.end:
dw drop_
dw semicolon_s_
else
_code_header min_,'MI','N'
pop de
pop hl
call compare_de_hl_signed
jp max.2
endif
; ----------------------------------------------
if 0 ; XXX OLD
_colon_header max_,'MA','X'
dw two_dup_
dw less_than_
dw zero_branch_,max.end
dw swap_
max.end:
dw drop_
dw semicolon_s_
else
_code_header max_,'MA','X'
pop de
max.de:
pop hl
call compare_de_hl_signed
max.1:
ccf
max.2:
jp c,push_hl
ex de,hl
jp push_hl
endif
Change: in renamed as >in, blanks renamed as blank,; forgot during the vocabulary modernizing.
First tries to implement a more efficient parsing method, with parse.
Change: screen, p! and p@ are moved to the disk.
Improvement: Optimized version of s>d:
_code_header s_to_d_,'S>','D'
if 0 ; XXX OLD
pop de
ld hl,0
ld a,d
and 0x80 ; negative?
jr z,s_to_d.end ; jump if not negative
dec hl
s_to_d.end:
jp push_de_hl
else ; XXX NEW
ld hl,0
pop de
ld a,d
or a
jp p,push_de_hl ; jump if positive
dec hl
jp push_de_hl
endif
Fix: severe error recently introduced in id..
New: 2>r and 2r>, adapted from DZX-Forth:
; ----------------------------------------------
_header _two_to_r,'2>','R'
; 2>r ( -- x1 x2 ) ( R: x1 x2 -- )
ld hl,(return_stack_pointer)
ld de,-cell*2
add hl,de
ld (return_stack_pointer),hl
jp two_store.into_hl_pointer
; ----------------------------------------------
_header _two_from_r,'2R','>'
; 2r> ( -- x1 x2 ) ( R: x1 x2 -- )
ld hl,(return_stack_pointer)
push hl
ld de,cell*2
add hl,de
ld (return_stack_pointer),hl
jp two_fetch_pfa
The original fig-Forth text is removed. It has become obsolete after implementing parse:
if 0 ; XXX OLD
_colon_header text_,'TEX','T'
; text ( c "ccc<c>" -- pad len )
; Accept following text to `pad`. _c_ is the text delimiter.
dw here_,c_slash_l_,one_plus_,blank_ ; fill the word buffer with blanks
dw word_
dw here_ ; origin
dw pad_ ; destination
dw c_slash_l_,one_plus_ ; count
dw cmove_
dw pad_,count_
dw semicolon_s_
endif
variable, 2variable, constant, 2constant and label are simplified, rewritten around create.
Adapted ." to parse:
_colon_header dot_quote_,'.','"',immediate
if 0 ; XXX OLD
dw c_lit_
db '"'
dw comp_question_ ; compiling?
dw zero_branch_,dot_quote.interpreting
; Compiling.
dw compile_,paren_dot_quote_
dw word_
dw here_,c_fetch_,one_plus_,allot_
dw semicolon_s_
dot_quote.interpreting:
dw word_,here_,count_,type_
dw semicolon_s_
else
dw c_lit_
db '"'
dw parse_ ; ( ca len )
dw comp_question_
dw zero_branch_,dot_quote.interpreting
; Compiling.
dw compile_,paren_dot_quote_,s_comma_
dw semicolon_s_
dot_quote.interpreting:
dw type_
dw semicolon_s_
endif
Copied .s from Afera. The original algorithm was taken from v.Forth.
: .s ( -- )
depth
dup s>d <# [char] > hold #s [char] < hold #> type space
if sp@ 2- s0 @ 2- do i @ . -2 +loop then ;
Copied 2nip from Afera to the library disk. The original code was taken from DZX-Forth.
2015-06-23
New: parse-word.
Improved cmove:
_code_header cmove_,'CMOV','E'
if 0 ; XXX OLD
ld l,c ; 04t 01b
ld h,b ; 04t 01b
pop bc ; 10t 01b
pop de ; 10t 01b
ex (sp),hl ; 19t 01b
ld a,b ; 04t 01b
or c ; 04t 01b
jr z,cmove.end ; 07t 02b / 12t
ldir ; 02b ; 21t/01t
cmove.end:
pop bc ; 10t 01b
; 62t 12b TOTAL
_jp_next
else ; XXX NEW
exx ; 04t 01b
pop bc ; 10t 01b
pop de ; 10t 01b
pop hl ; 10t 01b
ld a,b ; 04t 01b
or c ; 04t 01b
jr z,cmove.end ; 07t 02b / 12t
ldir ; 02b ; 21t/01t
cmove.end:
exx ; 04t 01b
; 52t 11b TOTAL
_jp_next
endif
Change: cmove> and move are moved to the kernel. move is rewritten in Z80, with code from DZX-Forth.
New: $!, with the code of DZX-Forth's packed. Name after lina's string words.
Improvement: faster and smaller -trailing, with code from DZX-Forth:
if 0 ; XXX OLD
_colon_header minus_trailing_,'-TRAILIN','G'
dw dup_,zero_
dw paren_do_
minus_trailing.do:
dw two_dup_,plus_
dw one_minus_
dw c_fetch_,b_l_,not_equals_
dw zero_branch_,minus_trailing.space
; not a space
dw leave_
dw branch_,minus_trailing.loop
minus_trailing.space:
dw one_minus_
minus_trailing.loop:
dw paren_loop_,minus_trailing.do
dw semicolon_s_
else ; XXX NEW
_code_header minus_trailing_,'-TRAILIN','G'
pop de
pop hl
push hl
add hl,de
ex de,hl
; de = address after the string
; hl = length of the string
minus_trailing.begin:
ld a,l
or h ; exhausted?
jp z,push_hl
dec de ; next char
ld a,(de)
cp ' ' ; space?
jp nz,push_hl
dec hl ; new length
jp minus_trailing.begin ; repeat
endif
Fix: 2>r and 2r> had typos in the header macro.
Faster and smaller char, with parse-word instead of word.
First tries with require and its related words, adapted from lina ciforth.
New: binary number printing words, after the lina's tool for hex numbers.
2015-06-24
A bit better code for (do), from CP/M fig-Forth 1.1g
_code_header paren_do_,'(DO',')'
if 0 ; XXX OLD -- original from Abersoft Forth
ld hl,(return_stack_pointer) ; 20t 03b
dec hl ; 06t 01b
dec hl ; 06t 01b
dec hl ; 06t 01b
dec hl ; 06t 01b
ld (return_stack_pointer),hl ; 16t 03b
pop de ; 10t 01b
ld (hl),e ; 07t 01b
inc hl ; 06t 01b
ld (hl),d ; 07t 01b
pop de ; 10t 01b
inc hl ; 06t 01b
ld (hl),e ; 07t 01b
inc hl ; 06t 01b
ld (hl),d ; 07t 01b
;126t 19b TOTAL
else ; XXX NEW -- from CP/M fig-Forth 1.1g
exx ; 04t 01b
pop de ; 10t 01b
pop bc ; 10t 01b
ld hl,(return_stack_pointer) ; 20t 03b
dec hl ; 06t 01b
ld (hl),b ; 07t 01b
dec hl ; 06t 01b
ld (hl),c ; 07t 01b
dec hl ; 06t 01b
ld (hl),d ; 07t 01b
dec hl ; 06t 01b
ld (hl),e ; 07t 01b
ld (return_stack_pointer),hl ; 16t 03b
exx ; 04t 01b
;116t 18b TOTAL
endif
2015-06-25
Fix: require and locate needed to save the parsed words to the circular string buffer.
Fix: emits didn't check values less than zero; this affected spaces and d.r.
New: smove, equivalent to swap move but much faster.
New: bank, required to use a memory page to store the name fields and link fields.
_code_header bank_,'BAN','K'
; doc{
;
; bank ( n -- )
;
; Page memory bank _n_ at 0xC000..0xFFFF.
;
; }doc
di
pop de ; e = bank
ld a,(sys_bankm) ; get the saved status of BANKM
and 0xF8 ; erase bits 0-2
or e ; modify bits 0-2
ld (sys_bankm),a ; update BANKM
out (bank1_port),a ; page the bank
ei
_jp_next
The fig-Forth name field format is definitively removed. It remained as an option, just in case, but everything works fine with the new format.
- Fix:
plothad a typo in the compilation of the Z80 code.
- Fix: branches shown by
decodestill were relatives.
Finished the conversion of [if] [else] [then].
Counted the number of times constants 0, 1, 2 and 3 are compiled in the code, in order to decide about them:
| Number | Times compiled (not including error numbers) |
|---|---|
| 0 | 20 |
| 1 | 11 |
| 2 | 11 |
| 3 | 6 |
2015-06-26
First changes to store the name and link fields in a memory bank (with a pointer to the correspondent cfa), freeing dictionary memory.
2015-06-27
Fix: The final memory bank selection in (find) corrupted the returned cfa.
Fix: The algorithm of the new cfa>nfa (for name fields in paged memory) had a bug.
Fix: The new nfa>string (for name fields in a paged memory) had a wrong header.
New: the version header for name fields in paged memory is finished.
2015-06-28
First tries with field names in paged memory. So far the code was tried without actually changing the memory bank, but using the same memory addresses. nfa>cfa and words need to change the bank.
New: n@ fetchs from the names bank.
Change: renamed s0 to sp0 and r0 to rp0, after Laxen&Perry's F83.
The old original optional code related to fig-Forth's find is removed. The new version of find with all its related words has been working fine.
2015-06-29
Fix: immediate and smudge didn't paged the names bank.
New: postpone:
_colon_header postpone_,'POSTPONE',immediate
; doc{
;
; postpone ( "name" -- ) \ ANS Forth, C I
;
; Skip leading space delimiters. Parse name delimited by a
; space. Find name. Append the compilation semantics of _name_ to
; the current definition.
;
; }doc
dw defined_ ; ( ca 0 | cfa 1 | cfa -1 )
dw dup_,question_defined_ ; error if not found
dw zero_less_than_ ; non-immediate word?
dw zero_branch_,postpone.end
; Non-immediate word.
dw compile_,compile_ ; compile `compile`
postpone.end:
dw comma_ ; compile the cfa
dw semicolon_s_
First drafts of alternative definitions of do-loop structures, with code adapted from Spectrum Forth-83, v.Forth and DZX-Forth, in order to implement ?do.
Change: now variable and 2variable do not initialize their contents, after ANS Forth. 3 has been removed.
Fix: continued could not be used from the command line, because it does not save and restore the input-source specification. A check is added, with ?loading; (load) is factored out, and called also by load.
fig-Forth recognizes the end of the input stream when a null character is found. Disk buffers already have a null at the end of the actual data space, and expect adds it after the typed text. enclose parses the null character as an unconditional delimiter and treats it apart in order to simulate the null word has been parsed, which is the word that actually does the unnesting.
The problem of the described method is the null character needs a special parsing treatment, what makes new words like skip and scan to be less versatile.
In order to solve that, a change has been made: instead of a null character, a null word is stored at the end of the buffers: a null character surrounded by spaces. This way, the null character needs no special treatment during the parsing. This new method is compatible with the original fig-Forth parsing words, though they will be replaced.
Change: expect is improved after Forth-83 (it does not add anything after the text any more); query is updated accordingly, adding the null word at the end of the received text.
Fix: The new version of word didn't updated >in to the space after the word, what caused the new versions of s", .( and .", that use parse, to include the first space of their strings.