libs/ext/os_dir.f

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; UrForth level 1: self-hosting 32-bit Forth compiler
   3 ;; Copyright (C) 2020 Ketmar Dark // Invisible Vector
   4 ;; GPLv3 ONLY
   5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   6 use-lib: asm
   7
   8 also os definitions
   9
  10 code: getdents  ( dentaddr dentsize fd -- errcode // bytesread // 0 )
  11   ld    ebx,TOS
  12   pop   edx
  13   pop   ecx
  14   ld    eax,141
  15   syscall
  16   ld    TOS,eax
  17   urnext
  18 endcode
  19
  20 2 cells 2+ 256 + constant #dent
  21
  22  0 constant dent-ino
  23  4 constant dent-off
  24  8 constant dent-reclen  ;; 2 bytes
  25 10 constant dent-namez
  26
  27
  28 previous definitions
  29
  30
  31 : open-dir  ( c-addr u -- dirfd wior )
  32   [ os:O-RDONLY os:O-DIRECTORY or ] literal 0 os:open dup -if err-file-not-found else 0 endif
  33 ;
  34
  35 : close-dir  ( dirfd -- wior )
  36   os:close if err-file-read-error else 0 endif
  37 ;
  38
  39 \ calls xt for each directory entry except "." and ".."
  40 \ xt: ( nameaddr namecount inode -- stopflag )
  41 \ name buffer is temporary, you should not store its address anywhere
  42 : foreach-dir  ( dirfd xt -- eflag wior )
  43   over -if 2drop 0 err-file-read-error exit endif
  44   os:#dent ralloca nrot >r 2>r  ( xt buf-dirfd )
  45   begin
  46     2r@ os:#dent swap os:getdents
  47     dup -if drop 2rdrop rdrop 0 err-file-read-error os:#dent rdealloca exit endif
  48     dup ifnot 2rdrop rdrop 0 os:#dent rdealloca exit endif
  49     2r@ drop swap ( buf bleft | xt buf-dirfd )
  50     2r> r@ nrot 2>r >r  ( buf bleft | xt buf-dirfd xt )
  51     begin
  52       over dup os:dent-ino + @ swap os:dent-namez + zcount  ( buf bleft uno addr count | xt buf-dirfd xt )
  53       2dup 2dup " ." s= nrot " .." s= or if 2drop drop
  54       else  ( buf bleft uno addr count | xt buf-dirfd xt )
  55         \ rot r@ execute  ( buf bleft stopflag | xt buf-dirfd xt )
  56         rot r@ 2rot 2>r execute 2r> rot
  57         ?dup if nrot 2drop 2rdrop 2rdrop 0 os:#dent rdealloca exit endif
  58       endif
  59       over os:dent-reclen + w@ /string
  60     dup 1- -until 2drop rdrop
  61   again
  62 ;
  63
  64 \ inode is zero when we hit end-of-dir (and the name is empty, i.e. count is 0)
  65 : (read-dir)  ( addr maxcount dirfd -- addr count inode wior )
  66   dup -if 2drop 0 0 err-file-read-error exit endif
  67   os:#dent ralloca >r
  68   os:dent-namez 1+ 0 begin  ( addr maxcount dirfd curlen dummy | buf )
  69     drop 2dup r@ swap rot os:getdents dup -22 ( EINVAL) =
  70   while
  71     swap 1+ swap over os:#dent >
  72   until nrot 2drop
  73   dup -if nip 0 swap err-file-read-error exit endif
  74   if 0 max over swap r@ os:dent-namez + zcount rot min dup >r rot swap move r>
  75      r@ os:dent-ino + @ 1 umax 0
  76   else drop 0 0 0 endif  ;; no more
  77   rdrop os:#dent rdealloca
  78 ; (hidden)
  79
  80 ;; this ignores "." and ".."
  81 \ inode is zero when we hit end-of-dir (and the name is empty, i.e. count is 0)
  82 : read-dir  ( addr maxcount dirfd -- addr count inode wior )
  83   >r begin 2dup r@ (read-dir) dup not-while
  84   2over 2dup " ." s= nrot " .." s= or while
  85   2drop 2drop repeat
  86   rdrop 2rot 2drop
  87 ;