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 / LABEL96.SEQ < prev    next >
Encoding:
Text File  |  1990-05-24  |  4.4 KB  |  133 lines
  1. \\ LONGLABL.SEQ         Modified local labels for long branches
  2.  
  3. {
  4.  
  5. : %"ERRMSG3     ( cfa A1 N1 -- )        \ a dummy filler till real one
  6.                 cr type drop ;
  7.  
  8. DEFER "ERRMSG3  ' %"errmsg3 is "errmsg3
  9.  
  10. ASSEMBLER DEFINITIONS ALSO
  11.  
  12. DEFER T@        FORTH ' @       ASSEMBLER IS T@
  13.  
  14. ' HERE ALIAS ASMHERE
  15.  
  16. }
  17.  =========================================================
  18.                BEGIN LOCAL LABELS SECTION:
  19.  =========================================================
  20.  
  21. {
  22.  
  23. FORTH DEFINITIONS
  24.  
  25. 0 value jmp_opcode
  26.  
  27.   0 value ?long
  28.   0 value ?long_lib
  29.  
  30. : long_branch   ( -- )
  31.                 on> ?long ;
  32.  
  33. : short_branch  ( -- )
  34.                 off> ?long ;
  35.  
  36. : long_library  ( -- )
  37.                 on> ?long_lib ;
  38.  
  39. : short_library ( -- )
  40.                 off> ?long_lib ;
  41.  
  42. short_branch            \ default to short branches
  43. short_library           \ also use short branches in library
  44.  
  45. ASSEMBLER DEFINITIONS
  46.  
  47. }
  48.  Translates a label reference to the appropriate dictionary
  49.  location and sets the "ever referenced?" flag.
  50.  
  51.  If the reference is a forward reference, then a linked list
  52.  of the forward references themselves is built using the
  53.  dictionary byte locations where the jump offsets are
  54.  "compiled".  The reason for using this technique at all is
  55.  that it allows an arbitrary number of forward references per
  56.  label to be made (within the jump offset limitations of
  57.  course) and that it requires table space only for the linked
  58.  list head pointer.  The technique is eloquent if convoluted
  59.  and, as a minimum, needs explanation.
  60. {
  61.  
  62. ' $ ALIAS $|    ( n1 -- n2 )
  63.  
  64. }
  65.  Resolves all local label forward references for a given
  66.  label.
  67. {
  68.  
  69. : >resL ( ^line -- )
  70.         [ FORTH ]
  71.         2+ @ dup 0=     \ if nothing to resolve
  72.         IF      drop exit           \   then exit
  73.         THEN    DUP>R
  74.      1+ BEGIN                       \ stack contains directory address of
  75.                                     \   displacement to be resolved
  76.                 DUP 1- TC@  jmp_opcode =        \ if we have a JMP WORD instruction
  77.                 IF      DUP T@ >R               \ save link for now
  78.                         ASMHERE OVER - 2-       \ calculate displacement
  79.                         OVER T!                 \ and put in jump instruction
  80.                         R> $FFFD OVER <>        \ $FFFD signifies end of list
  81.                 ELSE    dup 1- tc@ $F8 and
  82.                         dup  $20 =              \ SJMP  instruction or
  83.                         swap $28 = or           \ SCALL instruction
  84.                       if
  85.                         dup 1- t@ flip >r       \ save instruction & addr
  86.                         asmhere over - 1-       \ convert to relative
  87.                         r@ $F800 and or         \ add opcode back in
  88.                         flip over 1- t!         \ resolve opcode & addr
  89.                         r> $7FF and             \ mask to only address
  90.                         $7FE over <>            \ branch to self?
  91.                       else
  92.                         DUP TC@ >R
  93.                         ASMHERE OVER - 1-
  94.                         DUP $7F U>
  95.                         if      0 " Branch out of range, use LONG_BRANCH"
  96.                                 "errmsg3 abort
  97.                         then
  98.                         OVER TC! R> $FE OVER <> \ $FE signifies end of list
  99.                       then
  100.                 THEN
  101.         WHILE
  102.                 R@ TC@ jmp_opcode <>
  103.                 IF      $ff00 or    \ sign extend since link is backward
  104.                 THEN
  105.                 + 2+                \ now move to next item on list
  106.         REPEAT
  107.         R>DROP  2DROP ;
  108.  
  109. : $$:f  ( n -- )                \ defines a local label
  110.         [ FORTH ]
  111.         true !> ll-used?        \ set "labels used?" flag
  112.         llab>line
  113.         dup @ 0<>
  114.         if      0 " Label can't be multiply defined" "errmsg3 abort
  115.         then
  116.         dup >resL               \ resolve forward references if needed
  117.         ASMHERE swap ! ;        \ and set label for subsequent refs
  118.  
  119. : $:|   ( n -- )        \ allow use as prefix/postfix
  120.         [ FORTH ]
  121.         ?LONG 0=
  122.         IF      ['] $:f
  123.         ELSE    ['] $$:f
  124.         THEN    a;! a; ;
  125.  
  126. ONLY FORTH ALSO DEFINITIONS
  127.  
  128. }
  129.  =========================================================
  130.                 END LOCAL LABELS SECTION:
  131.  =========================================================
  132.  
  133.