git.gag.com Git - debian/pforth/blob - fth/filefind.fth

   1 \ @(#) filefind.fth 98/01/26 1.2\r
   2 \ FILE?  ( <name> -- , report which file this Forth word was defined in )\r
   3 \\r
   4 \ FILE? looks for ::::Filename and ;;;; in the dictionary\r
   5 \ that have been left by INCLUDE.  It figures out nested\r
   6 \ includes and reports each file that defines the word.\r
   7 \\r
   8 \ Author: Phil Burk\r
   9 \ Copyright 1992 Phil Burk\r
  10 \\r
  11 \ 00001 PLB 2/21/92 Handle words from kernel or keyboard.\r
  12 \               Support EACH.FILE?\r
  13 \ 961213 PLB Port to pForth.\r
  14 \r
  15 ANEW TASK-FILEFIND.FTH\r
  16 \r
  17 : BE@ { addr | val -- val , fetch from unaligned address in BigEndian order }\r
  18         4 0\r
  19         DO\r
  20                 addr i + c@\r
  21                 val 8 lshift or -> val\r
  22         LOOP\r
  23         val\r
  24 ;\r
  25 \r
  26 : BE! { val addr -- , store to unaligned address in BigEndian order }\r
  27         4 0\r
  28         DO\r
  29             val 3 i - 8 * rshift\r
  30                 addr i + c!\r
  31         LOOP\r
  32 ;\r
  33 : BEW@ { addr -- , fetch word from unaligned address in BigEndian order }\r
  34         addr c@ 8 lshift\r
  35         addr 1+ c@ OR\r
  36 ;\r
  37 \r
  38 : BEW! { val addr -- , store word to unaligned address in BigEndian order }\r
  39         val 8 rshift addr c!\r
  40         val addr 1+ c!\r
  41 ;\r
  42 \r
  43 \ scan dictionary from NFA for filename\r
  44 : F?.SEARCH.NFA { nfa | dpth stoploop keyb nfa0 -- addr count }\r
  45         0 -> dpth\r
  46         0 -> stoploop\r
  47         0 -> keyb\r
  48         nfa -> nfa0\r
  49         BEGIN\r
  50                 nfa prevname -> nfa\r
  51                 nfa 0>\r
  52                 IF\r
  53                         nfa 1+ be@\r
  54                         CASE\r
  55                                 $ 3a3a3a3a ( :::: )\r
  56                                 OF\r
  57                                         dpth 0=\r
  58                                         IF\r
  59                                                 nfa count 31 and\r
  60                                                 4 - swap 4 + swap\r
  61                                                 true -> stoploop\r
  62                                         ELSE\r
  63                                                 -1 dpth + -> dpth\r
  64                                         THEN\r
  65                                 ENDOF\r
  66                                 $ 3b3b3b3b ( ;;;; )\r
  67                                 OF\r
  68                                                 1 dpth + -> dpth\r
  69                                                 true -> keyb     \ maybe from keyboard\r
  70                                 ENDOF\r
  71                         ENDCASE\r
  72                 ELSE\r
  73                         true -> stoploop\r
  74                         keyb\r
  75                         IF\r
  76                                 " keyboard"\r
  77                         ELSE\r
  78                                 " 'C' kernel"\r
  79                         THEN\r
  80                         count\r
  81                 THEN\r
  82                 stoploop\r
  83         UNTIL\r
  84 ;\r
  85 \r
  86 : FINDNFA.FROM { $name start_nfa -- nfa true | $word false }\r
  87         context @ >r\r
  88         start_nfa context !\r
  89         $name findnfa\r
  90         r> context !\r
  91 ;\r
  92 \r
  93 \ Search entire dictionary for all occurences of named word.\r
  94 : FILE? {  | $word nfa done? -- , take name from input }\r
  95         0 -> done?\r
  96         bl word -> $word\r
  97         $word findnfa\r
  98         IF  ( -- nfa )\r
  99                 $word count type ."  from:" cr\r
 100                 -> nfa\r
 101                 BEGIN\r
 102                         nfa f?.search.nfa ( addr cnt )\r
 103                         nfa name> 12 .r   \ print xt\r
 104                         4 spaces type cr\r
 105                         nfa prevname dup -> nfa\r
 106                         0>\r
 107                         IF\r
 108                                 $word nfa findnfa.from  \ search from one behind found nfa\r
 109                                 swap -> nfa\r
 110                                 not\r
 111                         ELSE\r
 112                                 true\r
 113                         THEN\r
 114                 UNTIL\r
 115         ELSE ( -- $word )\r
 116                 count type ."  not found!" cr\r
 117         THEN\r
 118 ;\r
 119 \r