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