FE 3 : im 2 lp @ 13 + c! ret I : ; B c, 1 mode c! ret I im : gw FF scan ; : lit mode c@ if ret else 3 c, , ret then ; : ' gw find 14 + @ lit ; im : abc FF scan here 2 ne 3 c, , 4 c, ' bcode , ; 2 abc kbd@ 10 abc kb@ 11 abc rot 1B abc / 1E abc not 1F abc i 20 abc cprt@ 21 abc cprt! 22 abc i2 23 abc i3 24 abc shl 25 abc shr 26 abc or 27 abc xor 28 abc vidmap 29 abc mouse@ 2A abc vidput 2C abc cfill 2D abc tvidput 2E abc depth 13 abc disk! 2F abc charput : create gw here 0 ne ; : vari create , ; : var 0 vari ; : const gw 0 ne ; : asc skey lit ; im : ( asc ) scan ; im : cr FE emit ; : .( asc ) scan pad write cr ; .( it is a test ) : forget gw find dup 14 + @ h ! @ lp ! ; : on -1 swap ! ; : off 0 swap ! ; : 2dup over over ; : 2drop drop drop ; : space FF emit ; : nip swap drop ; : >= 1- > ; : <= 1+ < ; : = - if 0 else -1 then ; : neg 0 swap - ; : forexit pop pop pop drop dup 1+ push push push ; : done pop pop 1- push push ; : doexit pop pop drop 0 push push ; : bit@ shr -2 or -2 xor ; : to32bit 100 * + 100 * + 100 * + ; : mod 2dup / * - ; : rh gw -1 find dup @ prev @ ! ! ; : alloc do 0 c, loop ; var tmp : [ depth tmp ! 1 mode ! ; im : ] 0 mode ! depth tmp @ - do lit loop ; rh tmp : " asc " scan pad dup c@ c, incmod ; : i" asc " scan pad incmod ; : str here " const ; : writestr i write i c@ pop + 1+ push ; : ." 5 c, ' writestr , " ; im rh writestr : vector ." no vector ! " ; : defer gw here 1 ne 4 c, ' vector , ; : is 1+ ! ; rh vector : bound 2dup > if nip nip else drop 2dup > if drop else nip then then ; : bound? over < if 2drop 0 else > if 0 else -1 then then ; : \ until fkey FE = if done then loop ; im : tab. FD emit ; : abs dup 0 < if neg then ; 7FFFFFFF const max 80000000 const min 1 const version var to8bitt : to8bit to8bitt ! to8bitt dup c@ swap 1+ dup c@ swap 1+ dup c@ swap 1+ c@ ; rh to8bitt var tmp1 : d. dup 0 < if 0 swap - 2D emit then tmp1 off 3B9ACA00 A do 2dup / dup dup tmp1 @ + if 30 + emit 1 tmp1 ! else drop then over * swap push - pop A / loop 2drop tmp1 @ if else 30 emit then ; rh tmp1 var tmp1 : . dup 0 < if 0 swap - 2D emit then tmp1 off 10000000 8 do 2dup / dup dup tmp1 @ + if emit 1 tmp1 ! else drop then over * swap push - pop 10 / loop 2drop tmp1 @ if else 0 emit then ; rh tmp1 : ? @ . ; : depth. depth . ; : score 800 do i 400 * i 14 + disk! loop ; : dump 10 do 4 do dup c@ . space 1+ loop cr loop drop ; var tmp1 var tmp2 : rnd ( range -- result ) tmp1 @ 17 * B + dup tmp1 ! tmp2 @ over + 11 * 4 + dup tmp2 ! + swap mod ; rh tmp1 rh tmp2 100 const dynent \ dynamic memory support create dyntab dynent 8 * alloc create dynmem h @ 500000 + h ! dynmem vari dynpn : dyntaba 8 * dyntab + ; : dynde dyntaba off ; : dynp dyntaba @ ; : dynp! dyntaba ! ; : dyns dyntaba 4 + @ ; : dyns! dyntaba 4 + ! ; var dync : dynal ( size -- handle ) until dync @ dup dynp 0 = if dup done then \ size dync 1+ dup dynent = if drop 0 then dync ! loop \ size handle dynpn @ over dynp! 2dup dyns! swap dynpn @ + dynpn ! ; rh dync : dynresize ( nsize handle -- ) dup push dyns \ Nsize Osiz R: handle over < if \ Nsize R: handle i dynp dup push over + push \ Nsize R: handle Oloc Nendloc dyntab dynent do dup @ dup i3 > if i2 < if pop drop i3 dynp dynpn @ dup i3 dynp! i3 dyns cmove 0 push then else drop then 8 + loop drop pop pop 2drop then \ Nsize R: handle i dynp over + \ Nsize Nend R: handle dup dynpn @ > if dynpn ! else drop then \ Nsize R: handle pop dyns! ; : dync@ ( addr dynhandle ) dynp + c@ ; : dync! ( num addr dynhandle ) dynp + c! ; : dyn@ dynp swap 4 * + @ ; : dyn! dynp swap 4 * + ! ; : dyncon dynal const ; : statdyn cr ." " tab. ." " tab. ." " 0 dyntab dynent do dup @ if cr swap dup . swap tab. dup @ . tab. dup 4 + @ . then 8 + swap 1+ swap loop 2drop ; : dyn. ( dynhandle -- ) dup dynp swap dyns do dup c@ emit 1+ loop drop ; rh dynent rh dyntab rh dynmem rh dyntaba rh dynpn : Dstralloc ( -- strh ) \ string support 1 dynal dup dynp 0 swap c! ; : Dstral Dstralloc ; \ compatibility patch! : Dstrsure ( size strh -- ) swap push dup dyns 1- \ strh len i < if pop 20 + swap dynresize else pop 2drop then ; : Dstrlen ( strh -- length ) dynp c@ ; : c+Dstr ( chr strh -- ) dup Dstrlen 1+ over Dstrsure dynp dup c@ 1+ \ chr addr len 2dup swap c! + c! ; : c+lDstr ( chr strh -- ) dup Dstrlen 1+ over Dstrsure dynp dup c@ \ addr len over 1+ dup 1+ rot cmove dup dup c@ 1+ swap c! 1+ c! ; : Dstr. ( strh -- ) dynp write ; : Dstr2str ( strh mem -- ) push dynp dup c@ 1+ \ Saddr len pop swap cmove ; : str2Dstr ( mem strh -- ) over c@ 1+ dup push over Dstrsure \ mem strh pop do over i + c@ over dynp i + c! loop 2drop ; : Dstr+str ( hand addr -- ) dup c@ over + 1+ rot \ addr destaddr hand dynp count push \ addr destaddr src R: len swap i cmove \ addr R: len dup c@ pop + swap c! ; Dstralloc const defDstr Dstralloc const defDstr2 : D" asc " scan pad defDstr str2Dstr defDstr ; : D> FF scan pad defDstr str2Dstr defDstr ; : D>2 FF scan pad defDstr2 str2Dstr defDstr2 ; : Dstr+Dstr ( hand1 hand2 -- ) push push \ R: hand2 hand1 i2 Dstrlen i Dstrlen \ len2 len1 R: hand2 hand1 2dup + dup i2 dynp c! i2 Dstrsure pop dynp 1+ rot pop dynp 1+ + rot cmove ; : Dstrclear ( handle -- ) 0 over Dstrsure dynp 0 swap c! ; : Dstr2Dstr ( srchand desthand -- ) dup Dstrclear Dstr+Dstr ; : Dstr asc " scan Dstralloc pad over str2Dstr const ; var tmploc : Dstrlscan ( char strh -- loc ) tmploc off dynp 0 over c@ for \ char addr 1+ 2dup c@ = if i 1+ tmploc ! forexit then loop 2drop tmploc @ ; : Dstrrscan ( char strh -- loc ) tmploc off dynp \ char addr len dup c@ do 2dup 1+ i + c@ = if i 1+ tmploc ! doexit then loop 2drop tmploc @ ; rh tmploc : Dstrlscane ( char strh -- loc ) dup Dstrlen push Dstrlscan dup if pop drop else drop pop 1+ then ; : Dstrleft ( amo strh -- ) dup Dstrlen rot \ strh strlen amo 0 swap rot bound \ strh ramo swap 2dup Dstrsure dynp c! ; : Dstrright ( amo strh -- ) \ unoptimized! dup Dstrlen rot \ strh strlen amo 0 swap rot bound \ strh ramo swap 2dup Dstrsure push push \ R: strh ramo i2 dynp dup c@ \ loc len R: -,,- 2dup i 1- - + \ loc len srcA R: -,,- rot 1+ rot drop i \ srcA dstA amo R: -,,- cmove pop pop \ ramo strh dynp c! ; : Dstrcutl ( amo strh -- ) dup Dstrlen rot - dup 1 < if drop Dstrclear else swap Dstrright then ; var tmpdest var tmpsrc var tmpamo : Dstrsp ( char strhsrc strhdest -- ) tmpdest ! dup tmpsrc ! \ char srchand Dstrlscane tmpamo ! tmpsrc @ tmpdest @ Dstr2Dstr tmpamo @ dup tmpsrc @ Dstrcutl 1- tmpdest @ Dstrleft ; rh tmpdest rh tmpsrc rh tmpamo : Dv ( addr -- ) Dstral swap ! ; : Df ( addr -- ) @ dynde ; 24 400 * const fsroot \ filesystem support 25 const fsfatbeg 4000 const fsfatsiz fsfatsiz 4 * 400 / 1+ fsfatbeg + const fsdata asc f asc r asc e asc e to32bit const fsextfree asc l asc i asc s asc t to32bit const fsextlist Dstr \" fspath create dib 400 alloc -1 vari dibblock : dibload dup dibblock @ = if drop else dup dibblock ! dib disk@ then ; : dibsave dup dibblock ! dib swap disk! ; var tmpfrom var tmpto var tmpamo var tmpramo : diskload ( fromdisk tomem amount -- ) tmpamo ! tmpto ! tmpfrom ! until tmpamo @ if tmpfrom @ 400 / dibload 0 400 tmpfrom @ 400 mod dup push - tmpamo @ bound tmpramo ! dib pop + tmpto @ tmpramo @ 2dup + tmpto ! cmove tmpamo @ tmpramo @ - tmpamo ! tmpfrom @ tmpramo @ + tmpfrom ! else done then loop ; : disksave \ frommem todisk amount -- tmpamo ! tmpto ! tmpfrom ! until tmpamo @ if tmpto @ 400 / dibload 0 400 tmpto @ 400 mod dup push - tmpamo @ bound tmpramo ! tmpfrom @ dib pop + tmpramo @ cmove dibblock @ dibsave tmpamo @ tmpramo @ - tmpamo ! tmpfrom @ tmpramo @ + tmpfrom ! tmpto @ tmpramo @ + tmpto ! else done then loop ; rh tmpamo rh tmpto rh tmpfrom rh tmpramo : fat@ 4 * dup push 400 / fsfatbeg + dibload pop 400 mod dib + @ ; : fat! 4 * dup push 400 / fsfatbeg + dibload pop 400 mod dib + ! dibblock @ dibsave ; var tmp1 : fatfindf until tmp1 @ fat@ -1 = if tmp1 @ done then tmp1 @ 1+ dup tmp1 ! fsfatsiz = if tmp1 off then loop ; rh tmp1 create formattmp i" listRootDireCtorYent" 0 , 0 , 0 , : format ." formatting ... " fsfatsiz do -1 i fat! loop -2 0 fat! formattmp fsroot 20 disksave ." done" cr ; rh formattmp 20 const maxfiles create fshandles 11 maxfiles * alloc \ 0 4 - FileDescription \ 4 4 - FileSize \ 8 4 - CurrentLocation \ 12 4 - CurrentSector \ 16 1 - updated : fsDfiledesc@ 11 * fshandles + @ ; : fsDfiledesc! 11 * fshandles + ! ; : fsDfilesize@ 11 * fshandles + 4 + @ ; : fsDfilesize! 11 * fshandles + 4 + ! ; : fsDcurloc@ 11 * fshandles + 8 + @ ; : fsDcurloc! 11 * fshandles + 8 + ! ; : fsDcursect@ 11 * fshandles + C + @ ; : fsDcursect! 11 * fshandles + C + ! ; : fsDupdated@ 11 * fshandles + 10 + c@ ; : fsDupdated! 11 * fshandles + 10 + c! ; : inithandles maxfiles do -1 i fsDfiledesc! loop ; inithandles forget inithandles : statfile cr ." handle" tab. ." pnt" tab. ." size" tab. ." CurLoc" tab. ." CurSect" tab. ." updated?" cr 0 maxfiles for -1 i fsDfiledesc@ - if i . tab. i fsDfiledesc@ . tab. i fsDfilesize@ . tab. i fsDcurloc@ . tab. i fsDcursect@ . tab. i fsDupdated@ . cr then loop ; : fsfreenext ( firstSector -- ) until dup -2 = if done else dup fat@ swap -1 swap fat! then loop drop ; create fsfiledesc 20 alloc : fsopen ( FileDescPnt -- handle ) maxfiles do i fsDfiledesc@ -1 = if i doexit then loop swap dup fsfiledesc 20 diskload \ handle desc over fsDfiledesc! \ handle [ fsfiledesc 14 + ] @ over fsDcursect! 0 over fsDcurloc! 0 over fsDupdated! [ fsfiledesc 18 + ] @ over fsDfilesize! ; : fspntdel ( FileDescPnt -- ) dup fsfiledesc 20 diskload \ pnt [ fsfiledesc 14 + ] @ fsfreenext fsextfree fsfiledesc ! fsfiledesc swap 20 disksave ; : fsclose ( handle -- ) dup fsDupdated@ if push i fsDfiledesc@ fsfiledesc 20 diskload i fsDfilesize@ [ 18 fsfiledesc + ] ! fsfiledesc i fsDfiledesc@ 20 disksave pop then -1 swap fsDfiledesc! ; rh fsfiledesc var tmpamo var tmpfrom var tmphand var tmploc var tmpramo var tmpsect var tmpmax : fssave \ fromMem toFhandle amount -- tmpamo ! dup fsDcurloc@ tmploc ! dup fsDcursect@ tmpsect ! tmphand ! tmpfrom ! until tmpamo @ if 0 400 tmploc @ 400 mod dup push - dup tmpmax ! tmpamo @ bound tmpramo ! tmpfrom @ tmpsect @ fsdata + 400 * pop + tmpramo @ disksave tmpramo @ tmpmax @ = if tmpsect @ fat@ dup -2 = if drop fatfindf dup tmpsect @ fat! -2 over fat! then tmpsect ! then tmpramo @ tmpamo @ over - tmpamo ! tmploc @ over + tmploc ! tmpfrom @ + tmpfrom ! else done then loop tmphand @ push tmploc @ i fsDcurloc! tmpsect @ i fsDcursect! -1 i fsDupdated! tmploc @ i fsDfilesize@ max bound pop fsDfilesize! ; var tmpto : fsload \ fromFhandle toMem amount -- tmpamo ! tmpto ! dup fsDcurloc@ tmploc ! dup fsDcursect@ tmpsect ! tmphand ! until tmpamo @ if 0 400 tmploc @ 400 mod dup push - dup tmpmax ! tmpamo @ bound tmpramo ! tmpsect @ fsdata + 400 * pop + tmpto @ tmpramo @ diskload tmpsect @ fat@ dup -2 = if drop else tmpramo @ tmpmax @ = if tmpsect ! else drop then then tmpramo @ tmpamo @ over - tmpamo ! tmploc @ over + tmploc ! tmpto @ + tmpto ! 0 tmploc @ tmphand @ fsDfilesize@ bound tmploc ! else done then loop tmphand @ tmploc @ over fsDcurloc! tmpsect @ swap fsDcursect! ; rh tmpamo rh tmpfrom rh tmphand rh tmploc rh tmpramo rh tmpsect rh tmpto rh tmpmax : fsabsloc ( handle -- loc ) dup fsDcursect@ fsdata + 400 * swap fsDcurloc@ 400 mod + ; var tmppnt var tmphand var curhand var tmpsect create tmpFdesc 21 alloc : fspntcreate ( dynHand descPnt -- newFileDescPnt ) tmppnt ! tmphand ! tmppnt @ fsopen curhand ! until curhand @ fsDfilesize@ curhand @ fsDcurloc@ 20 + >= if curhand @ fsDcursect@ tmpsect ! curhand @ tmpFdesc 20 fsload tmpFdesc @ fsextfree = if curhand @ fsDcurloc@ 20 - curhand @ fsDcurloc! tmpsect @ curhand @ fsDcursect! done then else done then loop FF tmpFdesc 20 cfill 0 [ tmpFdesc 18 + ] ! fatfindf -2 over fat! [ tmpFdesc 14 + ] ! 0 tmphand @ dync@ do i 1+ tmphand @ dync@ dup asc \ = if drop FF then tmpFdesc i + c! loop curhand @ fsabsloc tmpFdesc curhand @ 20 fssave curhand @ fsclose ; rh tmppnt rh tmphand rh curhand rh tmpsect : fseof ( handle -- bytesLeft ) dup fsDfilesize@ swap fsDcurloc@ - ; create tmppath FF alloc var tmppnt var tmphand var tmploc : fsgetdesc ( dynhand -- DescPnt) tmppath off 0 over dync@ if 1 over dync@ asc \ = if dup tmppath Dstr2str then then tmppath c@ 0 = if fspath tmppath Dstr2str dup tmppath Dstr+str then drop fsroot tmppnt ! until tmppath c@ if tmppath c@ push 1 i 2 + for i 1- tmppath c! tmppath i + c@ asc \ = if forexit then loop \ tmppath write cr tmppath c@ if tmppnt @ fsopen tmphand ! until tmphand @ fseof 20 >= if tmphand @ fsabsloc tmploc ! tmphand @ [ tmpFdesc 1+ ] 20 fsload 15 do i tmpFdesc c! tmpFdesc i + c@ FF - if doexit then loop tmpFdesc tmppath str=str? if tmploc @ tmppnt ! done then else -1 tmppnt ! done then loop tmphand @ fsclose else fsroot tmppnt ! then tmppath c@ dup push [ tmppath 1+ ] + tmppath i2 cmove pop pop swap - 1- dup -1 = if drop 0 then tmppath c! else done then tmppnt @ -1 = if done then loop tmppnt @ ; rh tmppath rh tmppnt rh tmphand rh tmploc 1 vari tmpdepth var tmploc : fspntls ( recursive? descpnt -- ) fsopen until \ handle dup fseof 20 >= if dup fsabsloc tmploc ! dup tmpFdesc 20 fsload tmpFdesc @ fsextfree - if [ tmpFdesc 18 + ] @ . tmpdepth @ do tab. loop tmpFdesc 14 type cr then over if tmpFdesc @ fsextlist = if tmpdepth @ 1+ tmpdepth ! -1 tmploc @ fspntls tmpdepth @ 1- tmpdepth ! then then else done then loop fsclose drop ; rh tmpFdesc rh tmpdepth rh tmploc : tmpls ." PATH: " fspath dup Dstr. cr fsgetdesc fspntls ; : fslsr -1 tmpls ; : fsls 0 tmpls ; rh tmpls : fscl ( dynhand -- ) push i Dstrlen if 1 i dync@ asc \ = if i fspath Dstr2Dstr else i fspath Dstr+Dstr then then pop drop ; var tmpstr1 var tmpstr2 var tmpstrpath var tmppnt : fscreate ( dynhand -- descpnt ) tmpstr1 Dv tmpstr2 Dv tmpstrpath Dv fspath tmpstrpath @ Dstr2Dstr tmpstr1 @ Dstr2Dstr until tmpstr1 @ Dstrlen if asc \ tmpstr1 @ tmpstr2 @ Dstrsp asc \ tmpstr2 @ c+Dstr \ tmpstr2 @ Dstr. cr tmpstr2 @ fsgetdesc dup -1 = if drop tmpstr2 @ fspath fsgetdesc fspntcreate then tmppnt ! tmpstr2 @ fscl else done then loop tmppnt @ tmpstrpath @ fspath Dstr2Dstr tmpstr1 Df tmpstr2 Df tmpstrpath Df ; rh tmpstr1 rh tmpstr2 rh tmpstrpath rh tmppnt : fstrunc ( Fhandle -- ) -1 over fsDupdated! dup fsDcurloc@ over fsDfilesize! fsDcursect@ \ sect dup fat@ dup 0 >= if fsfreenext else drop then -2 swap fat! ; : fsDsave ( Dynhand Dstr -- ) fscreate fsopen \ datahand filehand dup fstrunc dup rot \ filehand filehand datahand dup dynp rot \ filehand datahand from filehand rot dyns fssave \ fh fsclose ; : fsDload ( Dstr Dynhand -- ) push fsgetdesc fsopen \ Fhand R: Dhand dup fsDfilesize@ dup i dynresize \ Fhand Fsize R: Dhand over pop dynp rot fsload \ Fhand fsclose ; : fsDloadnew ( Dstr -- Dynhand ) 1 dynal swap over fsDload ; 1E8480 const tmpfrom var tmplen var tmpdyn var tmpstr : fsimport tmpfrom tmplen 4 diskload tmplen @ if ." file length: " tmplen @ dup . dynal tmpdyn ! tmpstr Dv F0 tmpstr @ Dstrsure [ tmpfrom 4 + ] tmpstr @ dynp F0 over c! 1+ F0 diskload FE tmpstr @ Dstrlscan 1- tmpstr @ Dstrleft ." file: " tmpstr @ Dstr. ." importing ..." [ tmpfrom 64 + ] tmpdyn @ dynp tmplen @ diskload tmpdyn @ tmpstr @ fsDsave ." done" cr tmpdyn Df tmpstr Df tmplen off tmplen tmpfrom 4 disksave then ; rh tmplen rh tmpfrom rh tmpdyn rh tmpstr : fsdel ( Dstr -- ) fsgetdesc dup -1 - if fspntdel else drop then ; : fscopy ( Dstr1 Dstr2 -- ) swap fsDloadnew dup rot fsDsave dynde ; : fsmove ( Dstr1 Dstr2 -- ) over swap fscopy fsdel ; : fsgettop ( Dstr1 Dstr2 -- ) 2dup Dstr2Dstr nip \ Dstr2 asc \ over Dstrrscan \ Dstr2 CharLoc swap Dstrcutl ; create incfiles 80 alloc \ File inclusion support -1 vari inccur : dyninc ( dynhandle -- ) inccur @ 1+ dup inccur ! \ hand cur 8 * incfiles + dup 4 + 0 swap ! ! ; : include ( StrHand -- ) fsDloadnew dyninc ; defer cmdline : (fkey inccur @ 8 * incfiles + dup @ ( adr handle ) dup dyns rot ( handle size adr ) 4 + @ > if ( handle ) inccur @ 8 * incfiles + 4 + dup @ ( handle adr+4 pointer ) dup 1+ rot ! ( handle pointer ) swap dynp + c@ else dynde inccur @ 1 - dup inccur ! 0 < if cmdline then FF then ; var tmpstr : modulechk ( Dstr -- ) tmpstr Dv dup tmpstr @ fsgettop asc # tmpstr @ c+lDstr tmpstr @ pad Dstr2str \ Dstr find if drop else tmpstr @ pad Dstr2str here 0 ne include then tmpstr Df ; rh tmpstr .( test test test ... ) \ format \ fsimport cr D" listF\5TH_AUTORUN" include ' (fkey ' fkey is