Merge branch 'master' of ssh://svjatoslav.eu:10006/home/n0/git/fifth
[fifth.git] / imageFile / f / 5th_boot
1 FE 3\r
2 \r
3 : im 2 lp @ 13 + c! ret I\r
4 : ; B c, 1 mode c! ret I im\r
5 : gw FF scan ;\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
9 \r
10  2 abc kbd@\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
16 2F abc charput\r
17 \r
18 : create gw here 0 ne ;\r
19 : vari create , ;\r
20 : var 0 vari ;\r
21 : const gw 0 ne ;\r
22 : asc skey lit ; im\r
23 : ( asc ) scan ; im\r
24 : cr FE emit ;\r
25 : .( asc ) scan pad write cr ; .( it is a test )\r
26 : forget gw find dup 14 + @ h ! @ lp ! ;\r
27 : on -1 swap ! ;\r
28 : off 0 swap ! ;\r
29 : 2dup over over ;\r
30 : 2drop drop drop ;\r
31 : space FF emit ;\r
32 : nip swap drop ;\r
33 : >= 1- > ;\r
34 : <= 1+ < ;\r
35 : = - if 0 else -1 then ;\r
36 : neg 0 swap - ;\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
42 : mod 2dup / * - ;\r
43 : rh gw -1 find dup @ prev @ ! ! ;\r
44 : alloc do 0 c, loop ;\r
45 var tmp\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
58   nip then then ;\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
62 : tab. FD emit ;\r
63 : abs dup 0 < if neg then ;\r
64 \r
65 7FFFFFFF const max\r
66 80000000 const min\r
67 1 const version\r
68 \r
69 var to8bitt\r
70 : to8bit to8bitt ! to8bitt dup c@ swap 1+ dup c@\r
71   swap 1+ dup c@ swap 1+ c@ ; rh to8bitt\r
72 \r
73 var tmp1\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
78   else drop then\r
79   over * swap push - pop A /\r
80   loop 2drop tmp1 @ if\r
81   else 30 emit then ; rh tmp1\r
82 \r
83 var tmp1\r
84 : . dup 0 < if 0 swap - 2D emit then\r
85 tmp1 off 10000000\r
86 8 do\r
87         2dup / dup dup tmp1 @ +\r
88         if\r
89                 emit 1 tmp1 !\r
90         else\r
91                 drop\r
92         then\r
93         over * swap push - pop 10 /\r
94 loop 2drop\r
95 tmp1 @ if else 0 emit then ;\r
96 rh tmp1\r
97 \r
98 : ? @ . ;\r
99 : depth. depth . ;\r
100 \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
103 \r
104 var tmp1 var tmp2\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
109 \r
110 100 const dynent                                 \ dynamic memory support\r
111 create dyntab dynent 8 * alloc\r
112 create dynmem h @ 500000 + h !\r
113 dynmem vari dynpn\r
114 \r
115 : dyntaba 8 * dyntab + ;\r
116 : dynde dyntaba off ;\r
117 : dynp dyntaba @ ;\r
118 : dynp! dyntaba ! ;\r
119 : dyns dyntaba 4 + @ ;\r
120 : dyns! dyntaba 4 + ! ;\r
121 \r
122 var dync\r
123 : dynal ( size -- handle )\r
124 until\r
125         dync @ dup dynp 0 = if dup done then    \ size dync\r
126         1+ dup dynent = if drop 0 then\r
127         dync !\r
128 loop                                            \ size handle\r
129 dynpn @ over dynp!\r
130 2dup dyns!\r
131 swap dynpn @ + dynpn ! ; rh dync\r
132 \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
137         dyntab dynent\r
138         do\r
139                 dup @ dup i3 >\r
140                 if\r
141                         i2 < if\r
142                                 pop drop i3 dynp dynpn @ dup i3\r
143                                 dynp! i3 dyns cmove 0 push\r
144                         then\r
145                 else\r
146                         drop\r
147                 then\r
148                 8 +\r
149         loop\r
150         drop pop pop 2drop\r
151 then                                    \ Nsize         R: handle\r
152 i dynp over +                           \ Nsize Nend    R: handle\r
153 dup dynpn @ > if\r
154         dynpn !\r
155 else\r
156         drop\r
157 then                                    \ Nsize         R: handle\r
158 pop dyns! ;\r
159 \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
165 \r
166 : statdyn\r
167 cr ." <hand>" tab. ." <addr>" tab. ." <size>"\r
168 0 dyntab dynent\r
169 do dup @ if cr swap dup . swap tab. dup @ . tab. dup 4 + @ . then 8 +\r
170 swap 1+ swap loop\r
171 2drop ;\r
172 \r
173 : dyn. ( dynhandle -- )\r
174   dup dynp swap dyns do\r
175   dup c@ emit 1+\r
176   loop drop ;\r
177 \r
178 rh dynent rh dyntab rh dynmem\r
179 rh dyntaba rh dynpn\r
180 \r
181 : Dstralloc ( -- strh )                         \ string support\r
182 1 dynal dup dynp 0 swap c! ;\r
183 \r
184 : Dstral Dstralloc ;    \ compatibility patch!\r
185 \r
186 : Dstrsure ( size strh -- )\r
187 swap push\r
188 dup dyns 1-     \ strh len\r
189 i < if\r
190         pop 20 + swap dynresize\r
191 else\r
192         pop 2drop\r
193 then ;\r
194 \r
195 : Dstrlen ( strh -- length )\r
196 dynp c@ ;\r
197 \r
198 : c+Dstr  ( chr strh -- )\r
199 dup Dstrlen 1+ over Dstrsure\r
200 dynp dup c@ 1+  \ chr addr len\r
201 2dup swap c!\r
202 + c! ;\r
203 \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
209 1+ c! ;\r
210 \r
211 : Dstr. ( strh -- ) dynp write ;\r
212 \r
213 : Dstr2str ( strh mem -- )\r
214 push dynp dup c@ 1+  \ Saddr len\r
215 pop swap cmove ;\r
216 \r
217 : str2Dstr ( mem strh -- )\r
218 over c@ 1+ dup push over Dstrsure       \ mem strh\r
219 pop do\r
220         over i + c@\r
221         over dynp i + c!\r
222 loop 2drop ;\r
223 \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
229 \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
235 \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
241 \r
242 : Dstrclear ( handle -- )\r
243 0 over Dstrsure\r
244 dynp 0 swap c! ;\r
245 \r
246 : Dstr2Dstr ( srchand desthand -- )\r
247 dup Dstrclear Dstr+Dstr ;\r
248 \r
249 : Dstr asc " scan Dstralloc pad over str2Dstr const ;\r
250 \r
251 var tmploc\r
252 : Dstrlscan ( char strh -- loc )\r
253 tmploc off\r
254 dynp 0 over c@ for      \ char addr\r
255         1+\r
256         2dup c@ = if i 1+ tmploc ! forexit then\r
257 loop\r
258 2drop\r
259 tmploc @ ;\r
260 \r
261 : Dstrrscan ( char strh -- loc )\r
262 tmploc off dynp         \ char addr len\r
263 dup c@ do\r
264         2dup 1+ i + c@ = if\r
265                 i 1+ tmploc !\r
266                 doexit\r
267         then\r
268 loop 2drop\r
269 tmploc @ ; rh tmploc\r
270 \r
271 : Dstrlscane ( char strh -- loc )\r
272 dup Dstrlen push Dstrlscan\r
273 dup if pop drop else drop pop 1+ then ;\r
274 \r
275 : Dstrleft ( amo strh -- )\r
276 dup Dstrlen rot         \ strh strlen amo\r
277 0 swap rot bound        \ strh ramo\r
278 swap 2dup Dstrsure\r
279 dynp c! ;\r
280 \r
281 : Dstrright ( amo strh -- ) \ unoptimized!\r
282 dup Dstrlen rot         \ strh strlen amo\r
283 0 swap rot bound        \ strh ramo\r
284 swap 2dup Dstrsure\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
290 dynp c! ;\r
291 \r
292 : Dstrcutl ( amo strh -- )\r
293 dup Dstrlen rot -\r
294 dup 1 < if\r
295         drop Dstrclear\r
296 else\r
297         swap Dstrright\r
298 then ;\r
299 \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
308 \r
309 : Dv ( addr -- ) Dstral swap ! ;\r
310 : Df ( addr -- ) @ dynde ;\r
311 \r
312 24 400 * const fsroot                           \ filesystem support\r
313 25 const fsfatbeg\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
318 \r
319 Dstr \" fspath\r
320 \r
321 create dib 400 alloc\r
322 -1 vari dibblock\r
323 : dibload dup dibblock @ = if drop\r
324   else dup dibblock ! dib disk@ then ;\r
325 : dibsave dup dibblock ! dib swap disk! ;\r
326 \r
327 var tmpfrom var tmpto var tmpamo var tmpramo\r
328 : diskload ( fromdisk tomem amount -- )\r
329   tmpamo ! tmpto ! tmpfrom !\r
330   until\r
331         tmpamo @ if\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
337         else\r
338                 done\r
339         then\r
340   loop ;\r
341 \r
342 : disksave      \ frommem todisk amount --\r
343   tmpamo ! tmpto ! tmpfrom !\r
344   until\r
345         tmpamo @ if\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
352         else\r
353                 done\r
354         then\r
355   loop ; rh tmpamo rh tmpto rh tmpfrom rh tmpramo\r
356 \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
360 \r
361 var tmp1\r
362 : fatfindf\r
363   until\r
364         tmp1 @ fat@ -1 = if tmp1 @ done then\r
365         tmp1 @ 1+ dup tmp1 !\r
366         fsfatsiz = if tmp1 off then\r
367   loop ; rh tmp1\r
368 \r
369 create formattmp i" listRootDireCtorYent" 0 , 0 , 0 ,\r
370 : format ." formatting ... " fsfatsiz do\r
371     -1 i fat!\r
372   loop\r
373   -2 0 fat!\r
374   formattmp fsroot 20 disksave\r
375   ." done" cr ; rh formattmp\r
376 \r
377 20 const maxfiles\r
378 create fshandles 11 maxfiles * alloc\r
379 \r
380 \  0 4 - FileDescription\r
381 \  4 4 - FileSize\r
382 \  8 4 - CurrentLocation\r
383 \ 12 4 - CurrentSector\r
384 \ 16 1 - updated\r
385 \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
396 \r
397 : inithandles maxfiles do\r
398         -1 i fsDfiledesc!\r
399 loop ; inithandles\r
400 forget inithandles\r
401 \r
402 : statfile\r
403 cr ." handle" tab. ." pnt" tab. ." size" tab. ." CurLoc"\r
404 tab. ." CurSect" tab. ." updated?" cr\r
405 0 maxfiles for\r
406         -1 i fsDfiledesc@ - if\r
407                 i . tab.\r
408                 i fsDfiledesc@ . tab.\r
409                 i fsDfilesize@ . tab.\r
410                 i fsDcurloc@ . tab.\r
411                 i fsDcursect@ . tab.\r
412                 i fsDupdated@ . cr\r
413         then\r
414 loop ;\r
415 \r
416 : fsfreenext ( firstSector -- )\r
417   until\r
418         dup -2 = if\r
419                 done\r
420         else\r
421                 dup fat@ swap -1 swap fat!\r
422         then\r
423   loop drop ;\r
424 \r
425 create fsfiledesc 20 alloc\r
426 : fsopen ( FileDescPnt -- handle )\r
427   maxfiles do\r
428         i fsDfiledesc@ -1 = if i doexit then\r
429   loop\r
430   swap dup fsfiledesc 20 diskload       \ handle desc\r
431   over fsDfiledesc!                     \ handle\r
432   [ fsfiledesc 14 + ] @ over fsDcursect!\r
433   0 over fsDcurloc!\r
434   0 over fsDupdated!\r
435   [ fsfiledesc 18 + ] @ over fsDfilesize! ;\r
436 \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
442 \r
443 : fsclose ( handle -- )\r
444   dup fsDupdated@ if\r
445     push\r
446     i fsDfiledesc@ fsfiledesc 20 diskload\r
447     i fsDfilesize@ [ 18 fsfiledesc + ] !\r
448     fsfiledesc i fsDfiledesc@ 20 disksave\r
449     pop\r
450   then\r
451   -1 swap fsDfiledesc! ; rh fsfiledesc\r
452 \r
453 var tmpamo var tmpfrom var tmphand var tmploc var tmpramo var tmpsect\r
454 var tmpmax\r
455 : fssave                \ fromMem toFhandle amount --\r
456   tmpamo !\r
457   dup fsDcurloc@ tmploc !\r
458   dup fsDcursect@ tmpsect !\r
459   tmphand ! tmpfrom !\r
460   until\r
461         tmpamo @ if\r
462                 0 400 tmploc @ 400 mod dup push - dup tmpmax ! tmpamo @\r
463                 bound tmpramo !\r
464                 tmpfrom @ tmpsect @ fsdata + 400 * pop + tmpramo @ disksave\r
465                 tmpramo @ tmpmax @ = if\r
466                         tmpsect @ fat@\r
467                         dup -2 = if\r
468                                 drop\r
469                                 fatfindf\r
470                                 dup tmpsect @ fat!\r
471                                 -2 over fat!\r
472                         then\r
473                         tmpsect !\r
474                 then\r
475                 tmpramo @\r
476                   tmpamo @ over - tmpamo !\r
477                   tmploc @ over + tmploc !\r
478                   tmpfrom @ + tmpfrom !\r
479         else\r
480                 done\r
481         then\r
482   loop\r
483   tmphand @ push\r
484     tmploc @ i fsDcurloc!\r
485     tmpsect @ i fsDcursect!\r
486     -1 i fsDupdated!\r
487     tmploc @ i fsDfilesize@ max bound pop fsDfilesize! ;\r
488 \r
489 var tmpto\r
490 : fsload        \ fromFhandle toMem amount --\r
491   tmpamo ! tmpto !\r
492   dup fsDcurloc@ tmploc !\r
493   dup fsDcursect@ tmpsect !\r
494   tmphand !\r
495   until\r
496         tmpamo @ if\r
497                 0 400 tmploc @ 400 mod dup push - dup tmpmax ! tmpamo @\r
498                 bound tmpramo !\r
499                 tmpsect @ fsdata + 400 * pop + tmpto @ tmpramo @ diskload\r
500                 tmpsect @ fat@\r
501                 dup -2 = if\r
502                         drop\r
503                 else\r
504                         tmpramo @ tmpmax @ = if tmpsect ! else drop then\r
505                 then\r
506                 tmpramo @\r
507                   tmpamo @ over - tmpamo !\r
508                   tmploc @ over + tmploc !\r
509                   tmpto @ + tmpto !\r
510                 0 tmploc @ tmphand @ fsDfilesize@ bound tmploc !\r
511         else\r
512                 done\r
513         then\r
514   loop\r
515   tmphand @\r
516     tmploc @ over fsDcurloc!\r
517     tmpsect @ swap fsDcursect! ;\r
518 \r
519 rh tmpamo rh tmpfrom rh tmphand rh tmploc rh tmpramo rh tmpsect rh tmpto\r
520 rh tmpmax\r
521 \r
522 : fsabsloc ( handle -- loc )\r
523 dup fsDcursect@ fsdata + 400 *\r
524 swap fsDcurloc@ 400 mod + ;\r
525 \r
526 var tmppnt var tmphand var curhand var tmpsect\r
527 create tmpFdesc 21 alloc\r
528 : fspntcreate ( dynHand descPnt -- newFileDescPnt )\r
529 tmppnt ! tmphand !\r
530 tmppnt @ fsopen curhand !\r
531 until\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
538                         done\r
539                 then\r
540         else\r
541                 done\r
542         then\r
543 loop\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
550         tmpFdesc i + c!\r
551 loop\r
552 curhand @ fsabsloc\r
553   tmpFdesc curhand @ 20 fssave\r
554   curhand @ fsclose ;\r
555 rh tmppnt rh tmphand rh curhand rh tmpsect\r
556 \r
557 : fseof ( handle -- bytesLeft )\r
558 dup fsDfilesize@ swap fsDcurloc@ - ;\r
559 \r
560 create tmppath FF alloc\r
561 var tmppnt var tmphand var tmploc\r
562 : fsgetdesc ( dynhand -- DescPnt)\r
563 tmppath off\r
564 0 over dync@ if\r
565         1 over dync@ asc \ = if dup tmppath Dstr2str then\r
566 then\r
567 tmppath c@ 0 = if\r
568         fspath tmppath Dstr2str\r
569         dup tmppath Dstr+str\r
570 then\r
571 drop\r
572 fsroot tmppnt !\r
573 until\r
574         tmppath c@ if\r
575                 tmppath c@ push\r
576                 1 i 2 + for\r
577                         i 1- tmppath c!\r
578                         tmppath i + c@ asc \ = if forexit then\r
579                 loop\r
580                 \ tmppath write cr\r
581                 tmppath c@ if\r
582                         tmppnt @ fsopen tmphand !\r
583                         until\r
584                                 tmphand @ fseof 20 >= if\r
585                                         tmphand @ fsabsloc tmploc !\r
586                                         tmphand @ [ tmpFdesc 1+ ] 20 fsload\r
587                                         15 do\r
588                                                 i tmpFdesc c!\r
589                                                 tmpFdesc i + c@ FF -\r
590                                                 if doexit then\r
591                                         loop\r
592                                         tmpFdesc tmppath str=str? if\r
593                                                 tmploc @ tmppnt !\r
594                                                 done\r
595                                         then\r
596                                 else\r
597                                         -1 tmppnt !\r
598                                         done\r
599                                 then\r
600                         loop\r
601                         tmphand @ fsclose\r
602                 else\r
603                         fsroot tmppnt !\r
604                 then\r
605                 tmppath c@ dup push [ tmppath 1+ ] + tmppath i2 cmove\r
606                 pop pop swap - 1-\r
607                 dup -1 = if drop 0 then tmppath c!\r
608         else\r
609                 done\r
610         then\r
611         tmppnt @ -1 = if done then\r
612 loop\r
613 tmppnt @ ; rh tmppath rh tmppnt rh tmphand rh tmploc\r
614 \r
615 1 vari tmpdepth var tmploc\r
616 : fspntls  ( recursive? descpnt -- )\r
617 fsopen\r
618 until   \ handle\r
619         dup fseof 20 >= if\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
626                 then\r
627                 over if\r
628                         tmpFdesc @ fsextlist = if\r
629                                 tmpdepth @ 1+ tmpdepth !\r
630                                 -1 tmploc @ fspntls\r
631                                 tmpdepth @ 1- tmpdepth !\r
632                         then\r
633                 then\r
634         else\r
635                 done\r
636         then\r
637 loop\r
638 fsclose drop ; rh tmpFdesc rh tmpdepth rh tmploc\r
639 \r
640 : tmpls ." PATH: " fspath dup Dstr. cr fsgetdesc fspntls ;\r
641 : fslsr -1 tmpls ;\r
642 : fsls 0 tmpls ;\r
643 rh tmpls\r
644 \r
645 : fscl ( dynhand -- )\r
646 push\r
647 i Dstrlen if\r
648         1 i dync@ asc \ = if\r
649                 i fspath Dstr2Dstr\r
650         else\r
651                 i fspath Dstr+Dstr\r
652         then\r
653 then pop drop ;\r
654 \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
660 until\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
666                 dup -1 = if\r
667                         drop\r
668                         tmpstr2 @ fspath fsgetdesc fspntcreate\r
669                 then\r
670                 tmppnt !\r
671                 tmpstr2 @ fscl\r
672         else\r
673                 done\r
674         then\r
675 loop\r
676 tmppnt @\r
677 tmpstrpath @ fspath Dstr2Dstr\r
678 tmpstr1 Df tmpstr2 Df tmpstrpath Df ;\r
679 rh tmpstr1 rh tmpstr2 rh tmpstrpath rh tmppnt\r
680 \r
681 : fstrunc ( Fhandle -- )\r
682 -1 over fsDupdated!\r
683 dup fsDcurloc@ over fsDfilesize!\r
684 fsDcursect@     \ sect\r
685 dup fat@ dup 0 >= if\r
686         fsfreenext\r
687 else\r
688         drop\r
689 then\r
690 -2 swap fat! ;\r
691 \r
692 : fsDsave ( Dynhand Dstr -- )\r
693 fscreate fsopen         \ datahand filehand\r
694 dup fstrunc\r
695 dup rot                 \ filehand filehand datahand\r
696 dup dynp rot            \ filehand datahand from filehand\r
697 rot dyns fssave         \ fh\r
698 fsclose ;\r
699 \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
704 fsclose ;\r
705 \r
706 : fsDloadnew ( Dstr -- Dynhand )\r
707 1 dynal swap over fsDload ;\r
708 \r
709 1E8480 const tmpfrom\r
710 var tmplen var tmpdyn var tmpstr\r
711 : fsimport\r
712 tmpfrom tmplen 4 diskload\r
713 tmplen @ if\r
714         ." file length: " tmplen @ dup .\r
715         dynal tmpdyn !\r
716         tmpstr Dv\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
721         ."  importing ..."\r
722         [ tmpfrom 64 + ] tmpdyn @ dynp tmplen @ diskload\r
723         tmpdyn @ tmpstr @ fsDsave\r
724         ."  done" cr\r
725         tmpdyn Df tmpstr Df\r
726         tmplen off\r
727         tmplen tmpfrom 4 disksave\r
728 then ;\r
729 rh tmplen rh tmpfrom rh tmpdyn rh tmpstr\r
730 \r
731 : fsdel ( Dstr -- ) fsgetdesc dup -1 - if fspntdel else drop then ;\r
732 \r
733 : fscopy ( Dstr1 Dstr2 -- ) swap fsDloadnew dup rot fsDsave dynde ;\r
734 \r
735 : fsmove ( Dstr1 Dstr2 -- ) over swap fscopy fsdel ;\r
736 \r
737 : fsgettop ( Dstr1 Dstr2 -- )\r
738 2dup Dstr2Dstr nip       \ Dstr2\r
739 asc \ over Dstrrscan    \ Dstr2 CharLoc\r
740 swap Dstrcutl ;\r
741 \r
742 create incfiles 80 alloc                        \ File inclusion support\r
743 -1 vari inccur\r
744 \r
745 : dyninc ( dynhandle -- )\r
746 inccur @ 1+ dup inccur !        \ hand cur\r
747 8 * incfiles + dup 4 + 0 swap ! ! ;\r
748 \r
749 : include ( StrHand<filename> -- )\r
750 fsDloadnew dyninc ;\r
751 \r
752 defer cmdline\r
753 \r
754 : (fkey\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
760         swap dynp + c@\r
761 else\r
762         dynde\r
763         inccur @ 1 - dup inccur !\r
764         0 < if cmdline then FF\r
765 then ;\r
766 \r
767 var tmpstr\r
768 : modulechk ( Dstr -- )\r
769 tmpstr Dv\r
770 dup tmpstr @ fsgettop\r
771 asc # tmpstr @ c+lDstr\r
772 tmpstr @ pad Dstr2str        \ Dstr\r
773 find if\r
774         drop\r
775 else\r
776         tmpstr @ pad Dstr2str\r
777         here 0 ne\r
778         include\r
779 then\r
780 tmpstr Df ; rh tmpstr\r
781 \r
782 .( test test test ... )\r
783 \r
784 \ format\r
785 \ fsimport cr\r
786 \r
787 D" listF\5TH_AUTORUN" include\r
788 ' (fkey ' fkey is\r