3 : im 2 lp @ 13 + c! ret I
\r
4 : ; B c, 1 mode c! ret I im
\r
6 : lit mode c@ if ret else 3 c, , ret then ;
\r
7 : ' gw find 14 + @ lit ; im
\r
8 : abc FF scan here 2 ne 3 c, , 4 c, ' bcode , ;
\r
11 10 abc kb@ 11 abc rot 1B abc / 1E abc not
\r
12 1F abc i 20 abc cprt@ 21 abc cprt! 22 abc i2
\r
13 23 abc i3 24 abc shl 25 abc shr 26 abc or
\r
14 27 abc xor 28 abc vidmap 29 abc mouse@ 2A abc vidput
\r
15 2C abc cfill 2D abc tvidput 2E abc depth 13 abc disk!
\r
18 : create gw here 0 ne ;
\r
25 : .( asc ) scan pad write cr ; .( it is a test )
\r
26 : forget gw find dup 14 + @ h ! @ lp ! ;
\r
35 : = - if 0 else -1 then ;
\r
37 : forexit pop pop pop drop dup 1+ push push push ;
\r
38 : done pop pop 1- push push ;
\r
39 : doexit pop pop drop 0 push push ;
\r
40 : bit@ shr -2 or -2 xor ;
\r
41 : to32bit 100 * + 100 * + 100 * + ;
\r
43 : rh gw -1 find dup @ prev @ ! ! ;
\r
44 : alloc do 0 c, loop ;
\r
46 : [ depth tmp ! 1 mode ! ; im
\r
47 : ] 0 mode ! depth tmp @ - do lit loop ; rh tmp
\r
48 : " asc " scan pad dup c@ c, incmod ;
\r
49 : i" asc " scan pad incmod ;
\r
50 : str here " const ;
\r
51 : writestr i write i c@ pop + 1+ push ;
\r
52 : ." 5 c, ' writestr , " ; im rh writestr
\r
53 : vector ." no vector ! " ;
\r
54 : defer gw here 1 ne 4 c, ' vector , ;
\r
55 : is 1+ ! ; rh vector
\r
56 : bound 2dup > if nip nip
\r
57 else drop 2dup > if drop else
\r
59 : bound? over < if 2drop 0 else
\r
60 > if 0 else -1 then then ;
\r
61 : \ until fkey FE = if done then loop ; im
\r
63 : abs dup 0 < if neg then ;
\r
70 : to8bit to8bitt ! to8bitt dup c@ swap 1+ dup c@
\r
71 swap 1+ dup c@ swap 1+ c@ ; rh to8bitt
\r
74 : d. dup 0 < if 0 swap - 2D
\r
75 emit then tmp1 off 3B9ACA00
\r
76 A do 2dup / dup dup tmp1 @ +
\r
77 if 30 + emit 1 tmp1 !
\r
79 over * swap push - pop A /
\r
80 loop 2drop tmp1 @ if
\r
81 else 30 emit then ; rh tmp1
\r
84 : . dup 0 < if 0 swap - 2D emit then
\r
87 2dup / dup dup tmp1 @ +
\r
93 over * swap push - pop 10 /
\r
95 tmp1 @ if else 0 emit then ;
\r
101 : score 800 do i 400 * i 14 + disk! loop ;
\r
102 : dump 10 do 4 do dup c@ . space 1+ loop cr loop drop ;
\r
105 : rnd ( range -- result )
\r
106 tmp1 @ 17 * B + dup tmp1 !
\r
107 tmp2 @ over + 11 * 4 + dup tmp2 !
\r
108 + swap mod ; rh tmp1 rh tmp2
\r
110 100 const dynent \ dynamic memory support
\r
111 create dyntab dynent 8 * alloc
\r
112 create dynmem h @ 500000 + h !
\r
115 : dyntaba 8 * dyntab + ;
\r
116 : dynde dyntaba off ;
\r
118 : dynp! dyntaba ! ;
\r
119 : dyns dyntaba 4 + @ ;
\r
120 : dyns! dyntaba 4 + ! ;
\r
123 : dynal ( size -- handle )
\r
125 dync @ dup dynp 0 = if dup done then \ size dync
\r
126 1+ dup dynent = if drop 0 then
\r
131 swap dynpn @ + dynpn ! ; rh dync
\r
133 : dynresize ( nsize handle -- )
\r
134 dup push dyns \ Nsize Osiz R: handle
\r
135 over < if \ Nsize R: handle
\r
136 i dynp dup push over + push \ Nsize R: handle Oloc Nendloc
\r
142 pop drop i3 dynp dynpn @ dup i3
\r
143 dynp! i3 dyns cmove 0 push
\r
151 then \ Nsize R: handle
\r
152 i dynp over + \ Nsize Nend R: handle
\r
157 then \ Nsize R: handle
\r
160 : dync@ ( addr dynhandle ) dynp + c@ ;
\r
161 : dync! ( num addr dynhandle ) dynp + c! ;
\r
162 : dyn@ dynp swap 4 * + @ ;
\r
163 : dyn! dynp swap 4 * + ! ;
\r
164 : dyncon dynal const ;
\r
167 cr ." <hand>" tab. ." <addr>" tab. ." <size>"
\r
169 do dup @ if cr swap dup . swap tab. dup @ . tab. dup 4 + @ . then 8 +
\r
173 : dyn. ( dynhandle -- )
\r
174 dup dynp swap dyns do
\r
178 rh dynent rh dyntab rh dynmem
\r
179 rh dyntaba rh dynpn
\r
181 : Dstralloc ( -- strh ) \ string support
\r
182 1 dynal dup dynp 0 swap c! ;
\r
184 : Dstral Dstralloc ; \ compatibility patch!
\r
186 : Dstrsure ( size strh -- )
\r
188 dup dyns 1- \ strh len
\r
190 pop 20 + swap dynresize
\r
195 : Dstrlen ( strh -- length )
\r
198 : c+Dstr ( chr strh -- )
\r
199 dup Dstrlen 1+ over Dstrsure
\r
200 dynp dup c@ 1+ \ chr addr len
\r
204 : c+lDstr ( chr strh -- )
\r
205 dup Dstrlen 1+ over Dstrsure
\r
206 dynp dup c@ \ addr len
\r
207 over 1+ dup 1+ rot cmove
\r
208 dup dup c@ 1+ swap c!
\r
211 : Dstr. ( strh -- ) dynp write ;
\r
213 : Dstr2str ( strh mem -- )
\r
214 push dynp dup c@ 1+ \ Saddr len
\r
217 : str2Dstr ( mem strh -- )
\r
218 over c@ 1+ dup push over Dstrsure \ mem strh
\r
224 : Dstr+str ( hand addr -- )
\r
225 dup c@ over + 1+ rot \ addr destaddr hand
\r
226 dynp count push \ addr destaddr src R: len
\r
227 swap i cmove \ addr R: len
\r
228 dup c@ pop + swap c! ;
\r
230 Dstralloc const defDstr
\r
231 Dstralloc const defDstr2
\r
232 : D" asc " scan pad defDstr str2Dstr defDstr ;
\r
233 : D> FF scan pad defDstr str2Dstr defDstr ;
\r
234 : D>2 FF scan pad defDstr2 str2Dstr defDstr2 ;
\r
236 : Dstr+Dstr ( hand1 hand2 -- )
\r
237 push push \ R: hand2 hand1
\r
238 i2 Dstrlen i Dstrlen \ len2 len1 R: hand2 hand1
\r
239 2dup + dup i2 dynp c! i2 Dstrsure
\r
240 pop dynp 1+ rot pop dynp 1+ + rot cmove ;
\r
242 : Dstrclear ( handle -- )
\r
246 : Dstr2Dstr ( srchand desthand -- )
\r
247 dup Dstrclear Dstr+Dstr ;
\r
249 : Dstr asc " scan Dstralloc pad over str2Dstr const ;
\r
252 : Dstrlscan ( char strh -- loc )
\r
254 dynp 0 over c@ for \ char addr
\r
256 2dup c@ = if i 1+ tmploc ! forexit then
\r
261 : Dstrrscan ( char strh -- loc )
\r
262 tmploc off dynp \ char addr len
\r
264 2dup 1+ i + c@ = if
\r
269 tmploc @ ; rh tmploc
\r
271 : Dstrlscane ( char strh -- loc )
\r
272 dup Dstrlen push Dstrlscan
\r
273 dup if pop drop else drop pop 1+ then ;
\r
275 : Dstrleft ( amo strh -- )
\r
276 dup Dstrlen rot \ strh strlen amo
\r
277 0 swap rot bound \ strh ramo
\r
281 : Dstrright ( amo strh -- ) \ unoptimized!
\r
282 dup Dstrlen rot \ strh strlen amo
\r
283 0 swap rot bound \ strh ramo
\r
285 push push \ R: strh ramo
\r
286 i2 dynp dup c@ \ loc len R: -,,-
\r
287 2dup i 1- - + \ loc len srcA R: -,,-
\r
288 rot 1+ rot drop i \ srcA dstA amo R: -,,-
\r
289 cmove pop pop \ ramo strh
\r
292 : Dstrcutl ( amo strh -- )
\r
300 var tmpdest var tmpsrc var tmpamo
\r
301 : Dstrsp ( char strhsrc strhdest -- )
\r
302 tmpdest ! dup tmpsrc ! \ char srchand
\r
303 Dstrlscane tmpamo !
\r
304 tmpsrc @ tmpdest @ Dstr2Dstr
\r
305 tmpamo @ dup tmpsrc @ Dstrcutl
\r
306 1- tmpdest @ Dstrleft ;
\r
307 rh tmpdest rh tmpsrc rh tmpamo
\r
309 : Dv ( addr -- ) Dstral swap ! ;
\r
310 : Df ( addr -- ) @ dynde ;
\r
312 24 400 * const fsroot \ filesystem support
\r
314 4000 const fsfatsiz
\r
315 fsfatsiz 4 * 400 / 1+ fsfatbeg + const fsdata
\r
316 asc f asc r asc e asc e to32bit const fsextfree
\r
317 asc l asc i asc s asc t to32bit const fsextlist
\r
321 create dib 400 alloc
\r
323 : dibload dup dibblock @ = if drop
\r
324 else dup dibblock ! dib disk@ then ;
\r
325 : dibsave dup dibblock ! dib swap disk! ;
\r
327 var tmpfrom var tmpto var tmpamo var tmpramo
\r
328 : diskload ( fromdisk tomem amount -- )
\r
329 tmpamo ! tmpto ! tmpfrom !
\r
332 tmpfrom @ 400 / dibload
\r
333 0 400 tmpfrom @ 400 mod dup push - tmpamo @ bound tmpramo !
\r
334 dib pop + tmpto @ tmpramo @ 2dup + tmpto ! cmove
\r
335 tmpamo @ tmpramo @ - tmpamo !
\r
336 tmpfrom @ tmpramo @ + tmpfrom !
\r
342 : disksave \ frommem todisk amount --
\r
343 tmpamo ! tmpto ! tmpfrom !
\r
346 tmpto @ 400 / dibload
\r
347 0 400 tmpto @ 400 mod dup push - tmpamo @ bound tmpramo !
\r
348 tmpfrom @ dib pop + tmpramo @ cmove dibblock @ dibsave
\r
349 tmpamo @ tmpramo @ - tmpamo !
\r
350 tmpfrom @ tmpramo @ + tmpfrom !
\r
351 tmpto @ tmpramo @ + tmpto !
\r
355 loop ; rh tmpamo rh tmpto rh tmpfrom rh tmpramo
\r
357 : fat@ 4 * dup push 400 / fsfatbeg + dibload pop 400 mod dib + @ ;
\r
358 : fat! 4 * dup push 400 / fsfatbeg + dibload pop 400 mod dib + !
\r
359 dibblock @ dibsave ;
\r
364 tmp1 @ fat@ -1 = if tmp1 @ done then
\r
365 tmp1 @ 1+ dup tmp1 !
\r
366 fsfatsiz = if tmp1 off then
\r
369 create formattmp i" listRootDireCtorYent" 0 , 0 , 0 ,
\r
370 : format ." formatting ... " fsfatsiz do
\r
374 formattmp fsroot 20 disksave
\r
375 ." done" cr ; rh formattmp
\r
378 create fshandles 11 maxfiles * alloc
\r
380 \ 0 4 - FileDescription
\r
382 \ 8 4 - CurrentLocation
\r
383 \ 12 4 - CurrentSector
\r
386 : fsDfiledesc@ 11 * fshandles + @ ;
\r
387 : fsDfiledesc! 11 * fshandles + ! ;
\r
388 : fsDfilesize@ 11 * fshandles + 4 + @ ;
\r
389 : fsDfilesize! 11 * fshandles + 4 + ! ;
\r
390 : fsDcurloc@ 11 * fshandles + 8 + @ ;
\r
391 : fsDcurloc! 11 * fshandles + 8 + ! ;
\r
392 : fsDcursect@ 11 * fshandles + C + @ ;
\r
393 : fsDcursect! 11 * fshandles + C + ! ;
\r
394 : fsDupdated@ 11 * fshandles + 10 + c@ ;
\r
395 : fsDupdated! 11 * fshandles + 10 + c! ;
\r
397 : inithandles maxfiles do
\r
403 cr ." handle" tab. ." pnt" tab. ." size" tab. ." CurLoc"
\r
404 tab. ." CurSect" tab. ." updated?" cr
\r
406 -1 i fsDfiledesc@ - if
\r
408 i fsDfiledesc@ . tab.
\r
409 i fsDfilesize@ . tab.
\r
410 i fsDcurloc@ . tab.
\r
411 i fsDcursect@ . tab.
\r
416 : fsfreenext ( firstSector -- )
\r
421 dup fat@ swap -1 swap fat!
\r
425 create fsfiledesc 20 alloc
\r
426 : fsopen ( FileDescPnt -- handle )
\r
428 i fsDfiledesc@ -1 = if i doexit then
\r
430 swap dup fsfiledesc 20 diskload \ handle desc
\r
431 over fsDfiledesc! \ handle
\r
432 [ fsfiledesc 14 + ] @ over fsDcursect!
\r
435 [ fsfiledesc 18 + ] @ over fsDfilesize! ;
\r
437 : fspntdel ( FileDescPnt -- )
\r
438 dup fsfiledesc 20 diskload \ pnt
\r
439 [ fsfiledesc 14 + ] @ fsfreenext
\r
440 fsextfree fsfiledesc !
\r
441 fsfiledesc swap 20 disksave ;
\r
443 : fsclose ( handle -- )
\r
446 i fsDfiledesc@ fsfiledesc 20 diskload
\r
447 i fsDfilesize@ [ 18 fsfiledesc + ] !
\r
448 fsfiledesc i fsDfiledesc@ 20 disksave
\r
451 -1 swap fsDfiledesc! ; rh fsfiledesc
\r
453 var tmpamo var tmpfrom var tmphand var tmploc var tmpramo var tmpsect
\r
455 : fssave \ fromMem toFhandle amount --
\r
457 dup fsDcurloc@ tmploc !
\r
458 dup fsDcursect@ tmpsect !
\r
459 tmphand ! tmpfrom !
\r
462 0 400 tmploc @ 400 mod dup push - dup tmpmax ! tmpamo @
\r
464 tmpfrom @ tmpsect @ fsdata + 400 * pop + tmpramo @ disksave
\r
465 tmpramo @ tmpmax @ = if
\r
476 tmpamo @ over - tmpamo !
\r
477 tmploc @ over + tmploc !
\r
478 tmpfrom @ + tmpfrom !
\r
484 tmploc @ i fsDcurloc!
\r
485 tmpsect @ i fsDcursect!
\r
487 tmploc @ i fsDfilesize@ max bound pop fsDfilesize! ;
\r
490 : fsload \ fromFhandle toMem amount --
\r
492 dup fsDcurloc@ tmploc !
\r
493 dup fsDcursect@ tmpsect !
\r
497 0 400 tmploc @ 400 mod dup push - dup tmpmax ! tmpamo @
\r
499 tmpsect @ fsdata + 400 * pop + tmpto @ tmpramo @ diskload
\r
504 tmpramo @ tmpmax @ = if tmpsect ! else drop then
\r
507 tmpamo @ over - tmpamo !
\r
508 tmploc @ over + tmploc !
\r
510 0 tmploc @ tmphand @ fsDfilesize@ bound tmploc !
\r
516 tmploc @ over fsDcurloc!
\r
517 tmpsect @ swap fsDcursect! ;
\r
519 rh tmpamo rh tmpfrom rh tmphand rh tmploc rh tmpramo rh tmpsect rh tmpto
\r
522 : fsabsloc ( handle -- loc )
\r
523 dup fsDcursect@ fsdata + 400 *
\r
524 swap fsDcurloc@ 400 mod + ;
\r
526 var tmppnt var tmphand var curhand var tmpsect
\r
527 create tmpFdesc 21 alloc
\r
528 : fspntcreate ( dynHand descPnt -- newFileDescPnt )
\r
530 tmppnt @ fsopen curhand !
\r
532 curhand @ fsDfilesize@ curhand @ fsDcurloc@ 20 + >= if
\r
533 curhand @ fsDcursect@ tmpsect !
\r
534 curhand @ tmpFdesc 20 fsload
\r
535 tmpFdesc @ fsextfree = if
\r
536 curhand @ fsDcurloc@ 20 - curhand @ fsDcurloc!
\r
537 tmpsect @ curhand @ fsDcursect!
\r
544 FF tmpFdesc 20 cfill
\r
545 0 [ tmpFdesc 18 + ] !
\r
546 fatfindf -2 over fat! [ tmpFdesc 14 + ] !
\r
547 0 tmphand @ dync@ do
\r
548 i 1+ tmphand @ dync@
\r
549 dup asc \ = if drop FF then
\r
553 tmpFdesc curhand @ 20 fssave
\r
554 curhand @ fsclose ;
\r
555 rh tmppnt rh tmphand rh curhand rh tmpsect
\r
557 : fseof ( handle -- bytesLeft )
\r
558 dup fsDfilesize@ swap fsDcurloc@ - ;
\r
560 create tmppath FF alloc
\r
561 var tmppnt var tmphand var tmploc
\r
562 : fsgetdesc ( dynhand -- DescPnt)
\r
565 1 over dync@ asc \ = if dup tmppath Dstr2str then
\r
568 fspath tmppath Dstr2str
\r
569 dup tmppath Dstr+str
\r
578 tmppath i + c@ asc \ = if forexit then
\r
582 tmppnt @ fsopen tmphand !
\r
584 tmphand @ fseof 20 >= if
\r
585 tmphand @ fsabsloc tmploc !
\r
586 tmphand @ [ tmpFdesc 1+ ] 20 fsload
\r
589 tmpFdesc i + c@ FF -
\r
592 tmpFdesc tmppath str=str? if
\r
605 tmppath c@ dup push [ tmppath 1+ ] + tmppath i2 cmove
\r
607 dup -1 = if drop 0 then tmppath c!
\r
611 tmppnt @ -1 = if done then
\r
613 tmppnt @ ; rh tmppath rh tmppnt rh tmphand rh tmploc
\r
615 1 vari tmpdepth var tmploc
\r
616 : fspntls ( recursive? descpnt -- )
\r
620 dup fsabsloc tmploc !
\r
621 dup tmpFdesc 20 fsload
\r
622 tmpFdesc @ fsextfree - if
\r
623 [ tmpFdesc 18 + ] @ .
\r
624 tmpdepth @ do tab. loop
\r
625 tmpFdesc 14 type cr
\r
628 tmpFdesc @ fsextlist = if
\r
629 tmpdepth @ 1+ tmpdepth !
\r
630 -1 tmploc @ fspntls
\r
631 tmpdepth @ 1- tmpdepth !
\r
638 fsclose drop ; rh tmpFdesc rh tmpdepth rh tmploc
\r
640 : tmpls ." PATH: " fspath dup Dstr. cr fsgetdesc fspntls ;
\r
645 : fscl ( dynhand -- )
\r
648 1 i dync@ asc \ = if
\r
655 var tmpstr1 var tmpstr2 var tmpstrpath var tmppnt
\r
656 : fscreate ( dynhand -- descpnt )
\r
657 tmpstr1 Dv tmpstr2 Dv tmpstrpath Dv
\r
658 fspath tmpstrpath @ Dstr2Dstr
\r
659 tmpstr1 @ Dstr2Dstr
\r
661 tmpstr1 @ Dstrlen if
\r
662 asc \ tmpstr1 @ tmpstr2 @ Dstrsp
\r
663 asc \ tmpstr2 @ c+Dstr
\r
664 \ tmpstr2 @ Dstr. cr
\r
665 tmpstr2 @ fsgetdesc
\r
668 tmpstr2 @ fspath fsgetdesc fspntcreate
\r
677 tmpstrpath @ fspath Dstr2Dstr
\r
678 tmpstr1 Df tmpstr2 Df tmpstrpath Df ;
\r
679 rh tmpstr1 rh tmpstr2 rh tmpstrpath rh tmppnt
\r
681 : fstrunc ( Fhandle -- )
\r
682 -1 over fsDupdated!
\r
683 dup fsDcurloc@ over fsDfilesize!
\r
685 dup fat@ dup 0 >= if
\r
692 : fsDsave ( Dynhand Dstr -- )
\r
693 fscreate fsopen \ datahand filehand
\r
695 dup rot \ filehand filehand datahand
\r
696 dup dynp rot \ filehand datahand from filehand
\r
697 rot dyns fssave \ fh
\r
700 : fsDload ( Dstr Dynhand -- )
\r
701 push fsgetdesc fsopen \ Fhand R: Dhand
\r
702 dup fsDfilesize@ dup i dynresize \ Fhand Fsize R: Dhand
\r
703 over pop dynp rot fsload \ Fhand
\r
706 : fsDloadnew ( Dstr -- Dynhand )
\r
707 1 dynal swap over fsDload ;
\r
709 1E8480 const tmpfrom
\r
710 var tmplen var tmpdyn var tmpstr
\r
712 tmpfrom tmplen 4 diskload
\r
714 ." file length: " tmplen @ dup .
\r
717 F0 tmpstr @ Dstrsure
\r
718 [ tmpfrom 4 + ] tmpstr @ dynp F0 over c! 1+ F0 diskload
\r
719 FE tmpstr @ Dstrlscan 1- tmpstr @ Dstrleft
\r
720 ." file: " tmpstr @ Dstr.
\r
722 [ tmpfrom 64 + ] tmpdyn @ dynp tmplen @ diskload
\r
723 tmpdyn @ tmpstr @ fsDsave
\r
725 tmpdyn Df tmpstr Df
\r
727 tmplen tmpfrom 4 disksave
\r
729 rh tmplen rh tmpfrom rh tmpdyn rh tmpstr
\r
731 : fsdel ( Dstr -- ) fsgetdesc dup -1 - if fspntdel else drop then ;
\r
733 : fscopy ( Dstr1 Dstr2 -- ) swap fsDloadnew dup rot fsDsave dynde ;
\r
735 : fsmove ( Dstr1 Dstr2 -- ) over swap fscopy fsdel ;
\r
737 : fsgettop ( Dstr1 Dstr2 -- )
\r
738 2dup Dstr2Dstr nip \ Dstr2
\r
739 asc \ over Dstrrscan \ Dstr2 CharLoc
\r
742 create incfiles 80 alloc \ File inclusion support
\r
745 : dyninc ( dynhandle -- )
\r
746 inccur @ 1+ dup inccur ! \ hand cur
\r
747 8 * incfiles + dup 4 + 0 swap ! ! ;
\r
749 : include ( StrHand<filename> -- )
\r
750 fsDloadnew dyninc ;
\r
755 inccur @ 8 * incfiles + dup @ ( adr handle )
\r
756 dup dyns rot ( handle size adr )
\r
757 4 + @ > if ( handle )
\r
758 inccur @ 8 * incfiles + 4 + dup @ ( handle adr+4 pointer )
\r
759 dup 1+ rot ! ( handle pointer )
\r
763 inccur @ 1 - dup inccur !
\r
764 0 < if cmdline then FF
\r
768 : modulechk ( Dstr -- )
\r
770 dup tmpstr @ fsgettop
\r
771 asc # tmpstr @ c+lDstr
\r
772 tmpstr @ pad Dstr2str \ Dstr
\r
776 tmpstr @ pad Dstr2str
\r
780 tmpstr Df ; rh tmpstr
\r
782 .( test test test ... )
\r
787 D" listF\5TH_AUTORUN" include
\r