home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FPC355_2.ZIP / FPCSRC.ZIP / VIEW.SEQ < prev    next >
Encoding:
Text File  |  1990-07-23  |  4.3 KB  |  105 lines
  1. \ VIEW.SEQ       Modified to work with nested load files  by Robert Patten
  2. \                From  Viewing code for ZF.               by Tom Zimmer
  3.  
  4. only forth also definitions  \  hidden also
  5.  
  6. : NAME>PAD      ( A1 --- PAD )
  7.                 >r r@ ys: ?cs: pad r> yc@ 31 and 1+ cmovel  \ move name
  8.                 pad c@ 31 and pad c!                        \ clip count
  9.                 pad count + 1- dup c@ 127 and swap c!       \ mask last ch
  10.                 PAD     ;
  11.  
  12. \ hidden definitions
  13. \ : files_set     ( --- )      NOT NEEDED DELEATED REP
  14. \ : 1file         ( --- false | nfa )   NOT NEEDED DELEATED   REP
  15. \ 0 value lastname   ( rep )
  16. \ 0 value maxcfa     REP
  17.  
  18. FORTH DEFINITIONS
  19.  
  20. : viewfile   ( cfa | cfa+1 = a1 maxCFA ) \ maxcfa is zero if not found
  21. \ Locate words source file and retuen file name at pad and it's cfa.
  22. \ if cfa is a veriable in files vocabulary then cfa will return it's
  23. \ load file.
  24.         \ setup defalt file string. This file should be first file loaded.
  25.         DUP  ['] FILES U<= IF
  26.         [ also files ' kernel1.seq >name previous ] literal name>pad drop
  27.         ELSE 0 PAD !  THEN    0  swap
  28.                 \ scan vocabulary threads via index
  29.                 ['] files >body dup #threads 2* + swap do
  30.                 I @  swap ( cfa ) >r         \  thread-head
  31.                 begin  2dup u<               \ knot in thread
  32.                 while dup l>name             \ nfa of files variable
  33.                            name>             \ start of file's load area
  34.                            dup >body @ 1-    \ end of file's load area
  35.                            r@ u> swap r@  u< and  \
  36.                        \ true: word within file's load area
  37.                        if  nip dup           \ true better choice File
  38.                        then  y@              \ next knot in thread
  39.                 repeat drop r> ( cfa ) 2 +loop drop
  40.            dup if l>name dup name>   swap name>pad else pad  then swap ;
  41.  
  42. \ : ctrl          ( -- f ) 0  $417 c@l 4 and ;
  43.  
  44. 0 value loadedfrom
  45.  
  46. : >viewfile     ( cfa --- offset a1 )
  47. \ Locate word's source offset and file string a1 form code field address.
  48.         dup>r 1+ viewfile
  49.         LOADEDFROM                              \ if LOADEDFROM is on
  50.         if      off> LOADEDFROM                 \ clear LOADEDFROM
  51.                 r>drop >r drop r@ viewfile      \ find where word was loaded
  52.         then    r@ =
  53.         if      0
  54.         else    r@ >view y@
  55.         then    swap r>drop ;
  56.  
  57. : LOAD          ( n1 --- )      \ n1 is the line number to load from
  58.                 depth 1 < if 1 then     \ default to line 1
  59.                 ?fileopen
  60.                 dup>r >line             \ move to line n1
  61.                 cr ." Loading.."
  62.                 <load>
  63.                 r> =: loadline ;
  64.  
  65. ' fload alias include           \ make an alias that does the same thing as
  66.                                 \ FLOAD.
  67.  
  68. \u f-pc.seq     ' f-pc.seq  constant 'f-pc.seq  \ first file loded on kernel
  69. \u f-pch.seq    ' f-pch.seq constant 'f-pc.seq  \ 05/28/90 21:36:03.89 tjz
  70.  
  71. \- 'f-pc.seq    \S      \ Don't load more if 'F-PC.SEQ is not defined by now!
  72.  
  73. \ Change files variables loaded by meta86.seq
  74. \ not needed after first execution
  75. : files_set     ( --- )
  76.                 ['] files >body HERE 1000 + #THREADS 2* CMOVE ;
  77.  
  78. : 1file         ( --- false | nfa )
  79.                 HERE 1000 + #THREADS LARGEST DUP
  80.                 if      DUP L>NAME >r Y@ SWAP ! r>
  81.                 else    nip
  82.                 then    ;
  83.  
  84. files
  85.  
  86. : ChangeFilesVariables  ( -- )
  87. \ Change files variables in the kernel to support VIEWFILE.
  88.         [ files ] kernel1.seq @ ?exit  \ alredy changed
  89.         files_set
  90.         \ ignore files variables above kernel
  91.         begin 1file [ 'f-pc.seq >name ] literal u<= until
  92.         'f-pc.seq                       \ limit of kernel
  93.         600  654        \  line# in meta86.seq of last fload \ 05/25/90 tjz
  94.         do 1file dup if       \ valid kernel files variable
  95.                 cr I .s drop  dup .id \ display limit cfa loadline
  96.                 name> tuck  >body !   \ mark limts of load area
  97.                 i over >view y!       \ mark source file
  98.                 else drop leave then  -1 +loop drop ;
  99.  
  100. ChangeFilesVariables
  101. \u meta86.seq  files  'f-pc.seq meta86.seq !
  102. forget files_set  \ They have done their job.
  103. forth
  104.  
  105.