Subversion Repositories Kolibri OS

Rev

Blame | Last modification | View Log | Download | RSS feed

  1. ( Êîìïèëÿöèÿ ÷èñåë è ñòðîê â ñëîâàðü.
  2.   ÎÑ-íåçàâèñèìûå îïðåäåëåíèÿ.
  3.   Copyright [C] 1992-1999 A.Cherezov ac@forth.org
  4.   Ïðåîáðàçîâàíèå èç 16-ðàçðÿäíîãî â 32-ðàçðÿäíûé êîä - 1995-96ãã
  5.   Ðåâèçèÿ - ñåíòÿáðü 1999, ìàðò 2000
  6. )
  7.  
  8.  
  9. HEX
  10.  
  11. : HERE ( -- addr ) \ 94
  12. \ addr - óêàçàòåëü ïðîñòðàíñòâà äàííûõ.
  13.   DP @
  14.   DUP TO :-SET
  15.   DUP TO J-SET
  16. ;
  17.  
  18.  
  19. : _COMPILE,  \ 94 CORE EXT
  20. \ Èíòåðïðåòàöèÿ: ñåìàíòèêà íå îïðåäåëåíà.
  21. \ Âûïîëíåíèå: ( xt -- )
  22. \ Äîáàâèòü ñåìàíòèêó âûïîëíåíèÿ îïðåäåëåíèÿ, ïðåäñòàâëåíîãî xt, ê
  23. \ ñåìàíòèêå âûïîëíåíèÿ òåêóùåãî îïðåäåëåíèÿ.
  24.   ?SET
  25.   SetOP
  26.   0E8 C,              \ ìàøèííàÿ êîìàíäà CALL
  27.   DP @ CELL+ - ,
  28.   DP @ TO LAST-HERE
  29. ;
  30.  
  31. : COMPILE,  \ 94 CORE EXT
  32. \ Èíòåðïðåòàöèÿ: ñåìàíòèêà íå îïðåäåëåíà.
  33. \ Âûïîëíåíèå: ( xt -- )
  34. \ Äîáàâèòü ñåìàíòèêó âûïîëíåíèÿ îïðåäåëåíèÿ, ïðåäñòàâëåíîãî xt, ê
  35. \ ñåìàíòèêå âûïîëíåíèÿ òåêóùåãî îïðåäåëåíèÿ.
  36.     CON>LIT
  37.     IF  INLINE?
  38.       IF     INLINE,
  39.       ELSE   _COMPILE,
  40.       THEN
  41.     THEN
  42. ;
  43.  
  44. : BRANCH, ( ADDR -> ) \ ñêîìïèëèðîâàòü èíñòðóêöèþ ADDR JMP
  45.   ?SET SetOP SetJP E9 C,
  46.   DUP IF DP @ CELL+ - THEN ,    DP @ TO LAST-HERE
  47. ;
  48.  
  49. : RET, ( -> ) \ ñêîìïèëèðîâàòü èíñòðóêöèþ RET
  50.   ?SET SetOP 0xC3 C, OPT OPT_CLOSE
  51. ;
  52.  
  53.  
  54. : LIT, ( W -> )
  55.   ['] DUP  INLINE,
  56.  OPT_INIT
  57.  SetOP 0B8 C,  , OPT  \ MOV EAX, #
  58.  OPT_CLOSE
  59. ;
  60.  
  61. : DLIT, ( D -> )
  62.  SWAP LIT, LIT,
  63. ;
  64.  
  65. : RLIT, ( u -- )
  66. \ Ñêîìïèëèðîâàòü ñëåäóþùóþ ñåìàíòèêó:
  67. \ Ïîëîæèòü íà ñòåê âîçâðàòîâ ëèòåðàë u
  68.   68 C, ,  \ push dword #
  69. ;
  70.  
  71.  
  72. : ?BRANCH, ( ADDR -> ) \ ñêîìïèëèðîâàòü èíñòðóêöèþ ADDR ?BRANCH
  73.  ?SET
  74.  084 TO J_COD
  75.  ???BR-OPT
  76.  SetJP  SetOP
  77.  J_COD    \ JX áåç 0x0F
  78.  0x0F     \ êóñîê îò JX
  79.  C, C,
  80.  DUP IF DP @ CELL+ - THEN , DP @ TO LAST-HERE
  81. ;
  82.  
  83. DECIMAL
  84.  
  85.  
  86. : S, ( addr u -- )
  87. \ Çàðåçåðâèðîâàòü u áàéò ïðîñòðàíñòâà äàííûõ
  88. \ è ïîìåñòèòü òóäà ñîäåðæèìîå u áàéò èç addr.
  89.  DP @ SWAP DUP ALLOT CMOVE
  90. ;
  91.  
  92. : S", ( addr u -- )
  93. \ Ðàçìåñòèòü â ïðîñòðàíñòâå äàííûõ ñòðîêó, çàäàííóþ addr u,
  94. \ â âèäå ñòðîêè ñî ñ÷åò÷èêîì.
  95.  DUP C, S,
  96. ;
  97.  
  98. : SLIT, ( a u -- )
  99. \ Ñêîìïèëèðîâàòü ñòðîêó, çàäàííóþ addr u.
  100.  SLITERAL-CODE COMPILE,  S", 0 C,
  101. ;
  102.  
  103. : CLIT, ( a -- )
  104.  COUNT PAD $!
  105.  CLITERAL-CODE _COMPILE, PAD COUNT S", 0 C, ;
  106.  
  107.  
  108. : ", ( A -> )
  109. \ ðàçìåñòèòü â ïðîñòðàíñòâå äàííûõ ñòðîêó, çàäàííóþ àäðåñîì A,
  110. \ â âèäå ñòðîêè ñî ñ÷åò÷èêîì
  111.  COUNT S",
  112. ;
  113.  
  114. \ orig - a, 1 (short) èëè a, 2 (near)
  115. \ dest - a, 3
  116.  
  117. : >MARK ( -> A )
  118.  DP @ DUP TO :-SET 4 -
  119. ;
  120.  
  121. : <MARK ( -> A )
  122.  HERE
  123. ;
  124.  
  125. : >ORESOLVE1 ( A -> )
  126.  ?SET
  127.  DUP
  128.    DP @ DUP TO :-SET
  129.    OVER - 4 -
  130.    SWAP !
  131.  RESOLVE_OPT
  132. ;
  133.  
  134. : >ORESOLVE ( A, N -- )
  135.  DUP 1 = IF   DROP >ORESOLVE1
  136.          ELSE 2 <> IF -2007 THROW THEN \ ABORT" Conditionals not paired"
  137.               >ORESOLVE1
  138.          THEN
  139. ;
  140.  
  141. : >RESOLVE1 ( A -> )
  142.  HERE OVER - 4 -
  143.  SWAP !
  144. ;
  145.  
  146. : >RESOLVE ( A, N -- )
  147.  DUP 1 = IF   DROP >RESOLVE1
  148.          ELSE 2 <> IF -2007 THROW THEN \ ABORT" Conditionals not paired"
  149.               >RESOLVE1
  150.          THEN
  151. ;
  152.  
  153. : r>     ['] C-R>    INLINE, ;   IMMEDIATE
  154. : >r     ['] C->R    INLINE, ;   IMMEDIATE
  155.