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 / LINDEX.SEQ < prev    next >
Encoding:
Text File  |  1991-04-22  |  6.4 KB  |  196 lines
  1. \\ LINDEX.SEQ   Build an index of pointers to source for each target address
  2.  
  3. {
  4.  
  5. also forth definitions
  6. }
  7. 2variable filepointer-1         \ kept equal to filepointer
  8. 2variable (filepointer)         \ made equal to prior filepointer
  9.  
  10. variable >IN-1                  \ kept equal to >IN
  11. variable (>IN)                  \ made equal to prior >IN
  12. {
  13. variable A(>IN)                 \ made equal to prior (>IN) by assembler
  14.  
  15. 0 value ,ing            \ flag  =0 for ! and c!    =FFFF for , and c,
  16. 0 value callbyte        \ flag  =FFFF for the first byte of a hilevel call
  17. 0 value firstcodebyte   \ flag  =FFFF for the first byte of code
  18. 0 value othercodebyte   \ flag  =FFFF for other code bytes
  19. }
  20. : ?new>in ( -- ) \ keep track of the input buffer pointer ">in"
  21.         >in @ >in-1 @
  22.         2dup <> if      2dup < if       (>in) off
  23.                                         drop
  24.                                else
  25.                                         (>in) !
  26.                                then
  27.                         >in-1 !
  28.                 else
  29.                         2drop
  30.                 then
  31.         filepointer 2@ filepointer-1 2@
  32.         4dup d= if
  33.                         2drop 2drop
  34.                 else
  35.                         (filepointer) 2!
  36.                         filepointer-1 2!
  37.                 then
  38.         ;
  39.  
  40.  
  41. : lin-?stack
  42.         defers ?stack
  43.         ?new>IN
  44.         ;
  45. ' lin-?stack is ?stack
  46. {
  47.  
  48. handle flshndl                \ file handle for files file
  49. handle indhndl                \ file handle for index file
  50.  
  51. : ?indexopen ( -- f1 ) \ are indexing files open, if not make them
  52.                        \ return f1=true if symbol file is open now
  53.         flshndl >hndle @ 0<
  54.         if
  55.                 flshndl hcreate dup
  56.                 if  0 " Could not make files file." "errmsg2   then
  57.                 0=
  58.         else
  59.                 true
  60.         then
  61.         indhndl >hndle @ 0<
  62.         if
  63.                 indhndl hcreate dup
  64.                 if  0 " Could not make index file." "errmsg2   then
  65.                 0=
  66.         else
  67.                 true
  68.         then
  69.         and
  70.         ;
  71.  
  72.  
  73. variable flspoint
  74. variable lastseq  30 allot
  75.  
  76. : newseq
  77.         flshndl curpointer drop flspoint !       \ pointer in files file
  78.         seqhandle dup c@ 1+ flshndl hwrite drop  \ file handle to files file
  79.         $0A0D SP@ 2 flshndl hwrite 2drop
  80.         seqhandle count 30 min  lastseq  swap cmove   ;
  81.  
  82. : ?moreindex ( d -- d ) \ d is the double number location we want to write at
  83.         indhndl endfile
  84.         4dup d> if      pad $400 $ff fill
  85.                         4dup d-
  86.                         begin   pad $400 indhndl hwrite drop \ add 1k
  87.                                 at?
  88.                                 " I/-\" drop spinval 2/ 3 and + 1 type
  89.                                 at
  90.                                 incr> spinval
  91.                                 $400 0 d-
  92.                                 2dup 0 0 d< until
  93.                         2drop
  94.                 then
  95.         2drop
  96.         ;
  97. }
  98. Index record format
  99. 0,1             flspoint @      \  pointer to source file handle in TARGET.FLS
  100.                 ,ing $8000 and or       \ and flag for comma or store
  101.                                 \ this flag bit =1 for the first byte of
  102.                                 \                  an instruction
  103.                                 \               =1 for of a c,
  104.                                 \               =1 for the first byte of a ,
  105.                                 \               =0 otherwise
  106.  
  107. 2,3,4,5         (filepointer) 2@        \  line location in source file
  108.  
  109. 6               (>IN) c@        \  location in source line ( < 255 )
  110. 7               lbyte or        \  target byte value
  111.  
  112. \ 8,9             LOADLINE @      \ line number in source file
  113. {
  114.  
  115. 0 value lbyte  \ the byte that is going to the target
  116.  
  117. : file&flags ( -- n ) \ source file pointer and code flags
  118.         flspoint @                      \ source file pointer
  119.         firstcodebyte $1000 and or      \ flag first byte of code instruction
  120.         othercodebyte $2000 and or      \ flag other byte of code
  121.         callbyte      $4000 and or      \ flag a hilevel call
  122.         dup $7000 and
  123.         0= if  ,ing $8000 and or  then \ flag compiled by a , or c,
  124.         ;
  125.  
  126. : LINDEX ( n a -- n a ) \ patched into target c, and ,
  127.         \ take address, offset into .sym file
  128.         \ take file-line and write it in.
  129.         \ take (>in) and write it in.
  130.  
  131. \        ?new>in
  132.         ?indexopen
  133.         if      seqhandle count 30 min lastseq swap compare
  134.                 0<> if  newseq  then
  135.                 dup 8 *d \ 10 *d       \ location in index file
  136.                 ?moreindex      \ extend if necessary
  137.                 indhndl movepointer    \ move to correct location in file
  138.               \  LOADLINE @      \ line number in source file
  139.                 firstcodebyte   \ get column in source line ( < 255 )
  140.                         if    A(>IN) c@
  141.                         else  >in_word c@  \ (>IN)  c@
  142.                         then
  143.                 lbyte or        \  target byte value
  144.  
  145. \                (filepointer) 2@  \  line location in source file
  146.                 filepointer 2@ outbuf c@ 0 d-
  147.  
  148.                 file&flags      \ source file pointer and code flags
  149.                 sp@ ( 10) 8 indhndl hwrite 0= if ." WERR" cr then
  150.                 2drop 2drop \ drop
  151.         then  ;
  152.  
  153. : LINDEX1 ( byte a -- byte a ) \ patched into target c, ( c!-t )
  154.         over $100 *    !> lbyte
  155.         lindex
  156.         off> ,ing
  157.         ;
  158. : LINDEX2 ( word a -- word a ) \ patched into target ,  ( !-t )
  159.         lindex1
  160.         over $FF00 and !> lbyte
  161.         1+ lindex  1-
  162.         ;
  163.  
  164.  
  165. : lxc!-t ( char taddr -- )
  166.         lindex1
  167.         defers c!-t
  168.         ;
  169. : lx!-t  ( n taddr -- )
  170.         lindex2
  171.         defers !-t
  172.         ;
  173. : lxc,-t ( char -- )
  174.         on>  ,ing
  175.         defers c,-t
  176.         ;
  177. : lx,-t  ( n -- )
  178.         on>  ,ing
  179.         defers ,-t
  180.         ;
  181.  
  182.  
  183. : /ind ( -- ) \ put on command line to make an index file
  184.  
  185.         seqhandle indhndl  $>handle " IND" ">$ indhndl $>ext
  186.         seqhandle flshndl  $>handle " FLS" ">$ flshndl $>ext
  187.  
  188.         ['] lxc!-t is c!-t      \ link defered functions to defered words
  189.         ['] lx!-t  is !-t
  190.         ['] lxc,-t is c,-t
  191.         ['] lx,-t  is ,-t
  192.         ;
  193. previous definitions
  194. }
  195.  
  196.