FL \ eeReadWord ( eeAddr -- n1 ) : eeReadWord mcwT0 2 eeReadPage if eeErr cr then mcwT0 w@ ; \ eeWriteWord ( n1 eeAddr -- ) : eeWriteWord swap mcwT0 w! mcwT0 2 eeWritePage if eeErr cr then ; \ eeReadByte ( eeAddr -- c1 ) : eeReadByte eeReadWord FF and ; \ eeCopy ( addr1 addr2 u -- ) copy u bytes from addr1 to addr2, addr1 and addr2 must be on a 0x80 byte page boundary \ clears the pad, so make sure no commands follow \ and u must be a multiple of 0x80 and should not overlap : eeCopy 7F invert and rot 7f invert and rot 7f invert and rot 0 do over i + dup . mcPad 80 eeReadPage if eeErr leave then dup i + dup . mcPad 80 eeWritePage if eeErr leave then i 3FF and 0= if cr then 80 +loop 2drop cogid cogPadclr ; : _d1 cr over .word space dup .word _ecs bounds ; : _d2 cr .word _ecs ; : _d3 mcT 10 bounds do i c@ .byte space loop 2 spaces mcT 10 .str ; \ dump ( adr cnt -- ) uses mcT : dump _d1 do i _d2 i mcT 10 cmove _d3 10 +loop cr ; \ rdump ( adr cnt -- ) uses mcwT1 - mcwT8 : rdump _d1 do i _d2 i mcT 10 eeReadPage if mcT 10 0 fill then _d3 10 +loop cr ; \ adump ( adr cnt -- ) : adump cr over .word space dup .word _ecs bounds do cr i .word _ecs i 4 bounds do i @ .long space loop 4 +loop cr ; \ \ ( -- ) moves the parse pointer >in to the end of the line, tricky to redefine \ CTL-E gets traslated to \ by fast_load :  \ padsize mcw>in w! ; immediate exec \ ' ( -- addr ) returns the execution token for the next name, if not found it returns 0 : ' parsebl if pad>in nextword find 0= if _udf cr drop 0 then else 0 then ; \ cq ( -- addr ) returns the address of the counted string following this word and increments the IP past it : cq r> dup c@++ + alignw >r ; \ c" ( -- c-addr ) compiles the string delimited by ", runtime return the addr of the counted string ** valid only in that line : c" compile? if cm_cq w, 1 mcw>in w+! 22 parse dup c, dup pad>in mswHere w@ rot cmove dup allot 1+ mcw>in w+! herewal else 22 parse 1- pad>in 2dup c! swap 2+ mcw>in w+! then ; immediate exec \ the base address for the input buffer wvariable fl_base \ the number of buffered characters wvariable fl_count \ the old mswDictend wvariable fl_top \ the offset of the next byte in wvariable fl_in \ one fast load at a time wvariable fl_lock \ fl_buf ( -- t/f ) allocate all but 300 chars and load keys load true if successful : fl_buf mswDictend w@ mswHere w@ - 300 - 0 fl_count w! lockdict fl_lock w@ if freedict cr 0 else -1 fl_lock w! freedict -1 then \ ( u t/f -- ) true if successful so far if \ save the old mswDictend and initialize variables mswDictend w@ dup fl_top w! swap - dup fl_base w! dup fl_in w! 1- mswDictend w! 0 begin dup mswKeyTO w@ 0 do begin fkey? if dup 5C = \ if a backslash, throw away keys if drop begin keyto if D = else -1 then until else \ drop all characters between { } dup 7B = if drop begin keyto if 7D = else -1 then until else \ translate CTL-E 05 to backspace 5C dup 5 = if drop 5C then fl_in w@ c! 1+ fl_in w@ 1+ dup fl_top w@ = if _eoom clearkeys reset then fl_in w! then then 0 \ stay in begin until else drop -1 then \ no key, exit begin until until loop swap over = \ until count is the same until dup . ." chars" cr fl_count w! -1 else drop 0 then ; \ fl_skeys ( n -- ) emit the keys in the fast buffer : fl_skeys fl_lock w@ fl_count w@ 0<> and if fl_base w@ fl_count w@ bounds do i dup c@ emit mswDictend w! loop fl_top w@ mswDictend w! 0 fl_count w! lockdict 0 fl_lock w! freedict then ; : loadee 2dup F andn bounds do i mcT 10 eeReadPage drop mcT 10 bounds do i c@ emit loop 10 +loop dup F andn rot + swap F and dup if bounds do i eeReadByte emit loop else 2drop then ; : _caend c" cr " over cappend cogid over cappendnc c" 0 mcwEmitptr w! >cog" swap cappend ; : FL fl_buf if c" fl_skeys" mcT ccopy mcT _caend mcT cogXO then ; \ file area 8000 - FFFF \ individual files start on 128 byte boundaries, \ the first thing is the length as a 16 bit word, then a cstr which is the file name, and then the contents \ of the file 8000 constant eeBot 10000 constant eeTop \ f_fill ( c1 -- ) fill the eeprom file area with c1 : f_fill mcPad 80 rot fill eeTop eeBot do i mcPad 80 eeWritePage if eeErr cr leave then 80 +loop mcPad 80 bl fill ; \ f_clear ( -- ) clear the eeprom file area, only writes the length word to FFFF : f_clear eeTop eeBot do FFFF i eeWriteWord 80 +loop ; : _fi mcNumpad dup w@ swap 2+ c@ + 2+ 1+ 80 u/mod swap if 1+ then 80 u* ; \ list ( -- ) list the files names in the eeprom : list eeTop eeBot do i mcNumpad numpadsize namemax 1+ 2+ min eeReadPage if eeErr leave then mcNumpad w@ FFFF = if i . cr 80 leave else i . mcNumpad dup w@ . 2+ .cstr cr _fi then +loop ; \ f_find ( cstr -- n1 ) find the file, 0 if not found : f_find 0 eeTop eeBot do i mcNumpad numpadsize namemax 1+ 2+ min eeReadPage if eeErr leave then mcNumpad w@ FFFF = if nip 80 leave else over mcNumpad 2+ cstr= if drop i then _fi then +loop ; \ f_free ( -- n1 ) address of the first free file page, 0 if there are none : f_free 0 eeTop eeBot do i mcNumpad 4 eeReadPage if eeErr leave then mcNumpad w@ FFFF = if drop i 80 leave else _fi then +loop ; \ f_wfile ( -- ) write the file at fl_base for fl_count bytes, the format must be: \ word length the number of bytes in the content \ bytes cstr - filename \ bytes file contents : f_wfile f_free dup if dup fl_count w@ + eeTop < if fl_base w@ fl_count w@ bounds do dup i fl_count w@ dup 80 min swap over - fl_count w! eeWritePage if eeErr leave then 80 + 80 +loop drop else drop _eoom then else drop eeErr cr then ; \ FW ( n1 -- ) like a fast load but write to the file area, first entry after a blank lines must be 3 periods followed by the filename : FW fl_buf if fl_count w@ 0 do fl_base w@ c@ 2E = if leave else fl_base w@ 1+ fl_base w! fl_count w@ 1- fl_count w! then loop fl_base w@ 3 + 20 bounds do i c@ bl <= lasti? or if i leave then loop fl_base w@ - dup 3 - fl_base w@ 2+ c! fl_count w@ swap - dup fl_base w@ c! dup 8 rshift fl_base w@ 1+ c! if f_wfile then fl_top w@ mswDictend w! lockdict 0 fl_lock w! freedict then ; \ f_al ( addr1 -- n1 addr2) for file at addr1, get the length - n1, and the address of teh contents - addr2 : f_al dup eeReadWord over 2+ eeReadByte rot + 2+ 1+ ; \ f_load ( cstr -- ) load the file name following from eeprom : f_load f_find dup if f_al 0 mcT c! mcT cappendnc mcT cappendnc c" loadee" mcT cappend mcT _caend mcT cogXO else drop then ; \ load ( -- ) load the file name following from eeprom : load parsenw dup if f_load else drop then ; : version c" PropForth v2.5 2009OCT24 17:15 0" ; \ free ( -- ) display free main bytes and current cog longs : free mswDictend w@ mswHere w@ - . ." bytes free - " par mcwAhere w@ - . ." cog longs free" cr ; \ saveforth( -- ) write the running image to eeprom : saveforth c" mswHere" find if version dup c@ + dup c@ 1+ swap c! pfa>nfa mswHere w@ swap \ 2e emit begin dup w@ over eeWriteWord 2+ dup 7F and 0= until do ibound i - 80 min dup i dup rot eeWritePage if leave then 2e emit +loop else drop then cr ; \ _forget ( cstr -- ) wind the dictionary back to the word which follows - caution : _forget dup if find if pfa>nfa nfa>lfa dup mswHere w! w@ mswlastnfa w! else .cstr ??? cr then else drop then ; \ forget ( -- ) wind the dictionary back to the word which follows - caution : forget parsenw _forget ; \ this constant is used at boot time to set the forth starting routine, if it is changed \ it does not take effect until a reboot, a cog reset is not adequate cm_fstart wconstant cm_fstart \ fstart ( -- ) the start word : fstart cogid dup cogInbyte 10 lshift cm_entry 2 lshift or swap or resetDreg ! mcwInbyte m@ l>w swap 100 mcwInbyte w! 0 mcwEmitptr w! fMask @ mcwDebugcmd w! \ zero out cog data area par @ 8 + F8 0 fill \ initialize forth variables hex ca_varEnd mcwAhere w! \ initiliaze the common variables lockdict mswHere w@ 0= if 0 fl_lock w! lastnfa nfa>pfa 2+ alignl 4+ mswHere w! 7FFF dup mswMemend w! mswDictend w! then freedict rsTop 1- rsPtr ! FFFF = if 8 lshift cogid + vxcog w! else drop then c" boot" mcT ccopy cogid mcT cappendn mcT find if execute else drop then -1 begin compile? 0= if ." Cog" cogid . ." ok" cr then \ if the first time through set mcwDebugValue to -1 to let people know we are alive if -1 mcwDebugvalue m! then interpret 0 0 until ; : boot6 cogid >cog cog+ ; \ cog? ( -- ) display active forth cogs : cog? ." Forth cogs: " ffcog w@ . 2D emit space lfcog w@ . cr ; \ cog+ ( -- ) add a forth cog : cog+ ffcog w@ 1- dup 0>= if dup ffcog w! cogreset else drop then cog? ; \ cog- ( -- ) stop first forth cog, cannot be executed form the first forth cog : cog- ffcog w@ dup cogid <> swap 1+ dup lfcog w@ <= rot and if dup 1- cogstop ffcog w! else drop then cog? ; \ st? ( -- ) prints out the stack : st? ." ST: " stPtr @ 2+ dup stTop < if stTop swap - 0 do stTop 2- i - @ .long space loop else drop then cr ; \ sc ( -- ) clears the stack : sc stTop stPtr @ - 3 - dup . ." items cleared" cr dup 0> if 0 do drop loop then ; \ _pna ( addr -- ) print the address, contents and forth name : _pna dup .word 3a emit w@ dup .word space pfa>nfa .strname space ; \ pfa? ( addr -- t/f) true if addr is a pfa : pfa? dup pfa>nfa dup c@ dup 80 and 0= swap namemax and 0<> rot nfa>pfa rot if w@ then rot = and ; \ rs? ( -- ) prints out the return stack : rs? ." RS: " rsTop rsPtr @ 1+ - 0 do rsTop 1- i - @ dup 2- w@ pfa? if 2- _pna else .long space then loop cr ; \ lasm ( addr -- ) expects an address pointing to a structure in the following form \ empty long, long upper address of the assembler routine, long lower address of the assembler routine \ a series of longs which are the assembler codes : lasm 4+ dup m@ swap 4+ swap over m@ dup mcwAhere w! do 4+ dup m@ a, loop drop ; \ f_erase ( -- ) erase the word following from eeprom - DANGER - should be the last word only \ or following words may get overwritten when a new file is written to eeprom : f_erase parsenw dup if f_find dup if eeTop swap do FFFF i eeWriteWord 80 +loop else drop then else drop then ; \ no more symbols available \ mswlastnfa is generated by the forth spinmaker word