home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FPC355_5.ZIP / TCOM96.ZIP / TCOM96 / COMPILER / NEWHYPER.SEQ < prev    next >
Encoding:
Text File  |  1991-04-08  |  4.1 KB  |  116 lines
  1. \\ NEWHYPER.SEQ   Convert HYPER.NDX file to TARGET.NDX for debug/browsing
  2. ─────────────────────────────────────────────────────────────────────────────
  3. $Header:$
  4. ─────────────────────────────────────────────────────────────────────────────
  5. This program assumes a TARGET.FLS file exists, generated by TCOM,
  6. and that HYPER.NDX exists, generated by INDEX.COM
  7. It copies HYPER.NDX to TARGET.NDX while changing the file name references
  8. to pointers into TARGET.FLS
  9.  
  10. ─────────────────────────────────────────────────────────────────────────────
  11. $Log:$
  12. ─────────────────────────────────────────────────────────────────────────────
  13. {
  14. anew convndxwords
  15. decimal
  16.  
  17. 300 constant fblen
  18. create filesbuf fblen allot     \ Here we put a copy of TARGET.FLS
  19. create namepointers 40 allot    \ List of pointers into filesbuf,
  20.                                 \ pointing to starts of filenames
  21.  
  22. : ?serror ( f a c -- ) [ editor ] ?softerror  ;  \ show error in a box
  23.  
  24. : lookup ( a c -- a' c' ) \ look up the file name in the filenames list
  25.         2dup
  26.         1 /string               \ skip over the 249 character
  27.         filesbuf fblen search   \ look for name in files list
  28.         if
  29.                 0 38 do namepointers i + @      \ scan for name pointer
  30.                         over < if drop i leave then
  31.                     -2 +loop
  32.                 namepointers + @        \ this is the pointer into the file
  33.                 2 pick 1+ !
  34.         else
  35.                 drop
  36.         then
  37.         ;
  38.  
  39. : copyline ( -- ) \ copy every line into the new index
  40.         lineread count
  41.         dup
  42.         0<> if  over c@ 249 ( ∙ ) =
  43.                 if      \ convert filename line to a pointer into .FLS file
  44.                         lookup
  45.                 then
  46.                 tuck seqhandle+ hwrite
  47.                 - dup " Error writing TARGET.NDX" ?serror
  48.                 0=   \ flag for getting out of loop that repeats for each line
  49.           else
  50.                 nip     \ discard lineread address
  51.           then
  52.         ;
  53. \ check-ndx
  54.  
  55. : open.hyper ( -- f )
  56.         " HYPER.NDX" ">$ $hopen                 \ open HYPER.NDX
  57.         dup " Cannot open HYPER.NDX" ?serror
  58.         0.0 seqhandle movepointer       \ reset to beginning of file
  59.         0.0 filepointer 2!
  60.         loadline off                    \ reset file offset
  61.         ibreset
  62.         0 %!> screenchar
  63.         ;
  64.  
  65. 0 value tofilesbuf
  66. : >filesbuf ( c -- c a ) \ return a pointer to the files buffer, and update it
  67.         tofilesbuf
  68.         over +!> tofilesbuf ;
  69.  
  70. : read.fls ( -- f ) \ read in the files file
  71.         " TARGET.FLS" ">$ $hopen
  72.         dup " Cannot read filenames file" ?serror
  73.         0.0 seqhandle movepointer       \ reset to beginning of file
  74.         0.0 filepointer 2!
  75.         loadline off                    \ reset file offset
  76.         ibreset
  77.         0 %!> screenchar
  78.         dup
  79.         0= if                   \ get file into buffer and index it
  80.                 filesbuf !> tofilesbuf
  81.                 filesbuf fblen erase
  82.                 namepointers 40 erase
  83.                 0
  84.                 40 2 do lineread count
  85.                         tuck  >filesbuf swap cmove      \ copy line to buffer
  86.                         + dup namepointers i + !        \ index filenames
  87.                      2 +loop
  88.                 drop
  89.            then
  90.         seqhandle hclose drop
  91.         ;
  92.  
  93. : conv-hyper ( -- )
  94.         defers boot
  95.         ." Converting HYPER.NDX into TARGET.NDX format....."
  96.         read.fls                \ read the file list
  97.         open.hyper              \ open input index file
  98.         or
  99.         0= if                                   \ create new .NDX file
  100.                 " TARGET.NDX" ">$ seqhandle+ $>handle
  101.                 seqhandle+ hcreate " Couldn't Create TARGET.NDX" ?serror
  102.                 begin   copyline 0= until       \ copy every line
  103.          then
  104.         seqhandle+ hclose drop
  105.         seqhandle  hclose drop
  106.         cr
  107.         bye
  108.         ;
  109. ' conv-hyper is boot
  110. ' noop is .hello
  111. ' noop is .curfile
  112.  
  113. only forth also definitions
  114. save-exe newhyper
  115.  
  116.