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