home *** CD-ROM | disk | FTP | other *** search
/ Dream 52 / Amiga_Dream_52.iso / RiscOS / APP / DEVS / FORTH / WIMPFO.ZIP / !WimpForth / dthread < prev    next >
Text File  |  1996-02-17  |  3KB  |  97 lines
  1. \ DTHREAD.F             Display the Threads             by Tom Zimmer
  2.  
  3. cr .( Loading the Hash Thread Display words...)
  4.  
  5. 0 value thread-depth
  6.  
  7. 0 value words-cnt
  8. 0 value header-cnt
  9.  
  10. : count-voc     ( voc -- )
  11.                 dup voc#threads >r
  12.                 dup voc>vcfa call@
  13.                 dup  doClass  =           \ don't look through classes
  14.                 swap do|Class = or 0=     \ or invisible classes
  15.         if      r@ 0
  16.                 do      dup i cells +
  17.                         begin   @ ?dup
  18.                         while   1 +to words-cnt
  19.                                 dup l>name c@ 1+ 2 cells+ +to header-cnt
  20.                         repeat  start/stop
  21.                 loop
  22.         then    drop r>drop ;
  23.  
  24. : count-words   ( -- n1 )
  25.                 0 to words-cnt
  26.                 0 to header-cnt
  27.                 voc-link
  28.                 begin   @ ?dup
  29.                 while   dup vlink>voc count-voc
  30.                 repeat  words-cnt ;
  31.  
  32. : .words        ( -- )
  33.                 count-words . ;
  34.  
  35. : .1thread      ( voc-thread -- )
  36.                 0 to thread-depth
  37.                 begin   ?dup
  38.                 while   dup l>name .id 10 ?cr
  39.                         @
  40.                         1 +to thread-depth
  41.                         start/stop
  42.                 repeat  cr ." Thread depth: " thread-depth . cr ;
  43.  
  44. : 1tcount       ( voc-thread -- n1 )    \ get thread depth of voc thread
  45.                 0 to thread-depth
  46.                 begin   @ ?dup
  47.                 while   1 +to thread-depth
  48.                         start/stop
  49.                 repeat  thread-depth ;
  50.  
  51. : .thread       ( n1 -- )       \ display a thread of context vocabulary
  52.                 >r
  53.                 context @ dup voc>vcfa >name cr ." Vocabulary: " .id cr
  54.                 ." Thread " r@ .
  55.                 dup voc#threads ."  of " dup . ."  threads" cr
  56.                 r> min 0max cells+ @ .1thread ;
  57.  
  58. : .threads      ( -- )
  59.                 context @ dup voc>vcfa >name cr ." Vocabulary: " .id
  60.                 dup voc#threads 0
  61.                 do      cr ." Thread: " i . cr
  62.                         dup i cells + @ .1thread
  63.                         start/stop
  64.                 loop    drop ;
  65.  
  66. : .counts       ( -- )
  67.                 context @ dup voc>vcfa >name cr ." Vocabulary: " .id cr
  68.                 dup voc#threads 0
  69.                 do      26 ?line
  70.                          ."     Thread: "   i                 3 .r
  71.                         ."   depth:"
  72.                         dup i               cells + @ 1tcount 4 .r
  73.                         start/stop
  74.                 loop    drop
  75.                 0 to words-cnt
  76.                 cr ."   Vocabulary words: " context @ count-voc words-cnt .
  77.                 cr ." Total system words: " count-words . ;
  78.  
  79. 0 value tot-1thread
  80.  
  81. : 1thread       ( thread -- n1 )        \ count this thread in all vocs
  82.                 0 to tot-1thread
  83.                 voc-link
  84.                 begin   @ ?dup
  85.                 while   2dup vlink>voc
  86.                         dup voc>vcfa call@
  87.                         dup  doClass =          \ skip class vocs
  88.                         swap doClass = or 0=    \ skip invisible class vocs
  89.                         if      swap cells+
  90.                                 1tcount +to tot-1thread
  91.                         else    2drop
  92.                         then
  93.                 repeat  drop
  94.                 tot-1thread ;
  95.  
  96.  
  97.