Subversion Repositories Kolibri OS

Rev

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

  1. (  ˆ§ SMAL32
  2.    Œ®¤¨ä¨æ¨à®¢ ­­® Œ ªá¨¬®¢ë¬ Œ.Ž.
  3.   email:mak@rtc.ru
  4.   http://forth.spb.su:8888
  5.   â ¤ {812}705-92-03
  6.   â à {812}552-47-64
  7. )
  8. REQUIRE [IF] ~MAK\CompIF.f
  9. REQUIRE PLACE ~MAK\PLACE.f
  10. REQUIRE CASE  lib\ext\case.f
  11.  
  12. VOCABULARY S_ASSEM
  13. C" HIDDEN" FIND NIP 0=
  14. [IF] VOCABULARY HIDDEN
  15. [THEN]
  16.  
  17. ALSO HIDDEN DEFINITIONS
  18.  
  19. C" FLOAD" FIND NIP
  20. [IF]   FLOAD asmbase.f
  21. [ELSE] REQUIRE S= ~mak\asm\asmbase.f
  22. [THEN]
  23. : 1Op1 ( name ( byte --> )
  24.               ( --> )
  25.    CREATE C, DOES> C@ C,
  26. ;
  27.  
  28. 4 VALUE *DefDatasz
  29. \ 4 VALUE *DefDatasz
  30.  
  31. : 1Op1W ( name ( byte --> )
  32.               ( --> )
  33.    CREATE C, DOES> C@ C, *DefDatasz 4 = IF 0x66 C, THEN
  34. ;
  35.  
  36. : 1Op1D ( name ( byte --> )
  37.               ( --> )
  38.    CREATE C, DOES> C@ C, *DefDatasz 2 = IF 0x66 C, THEN
  39. ;
  40.  
  41. : 1Op2 ( name ( word --> )
  42.               ( --> )
  43.    CREATE W, DOES> W@ W,
  44. ;
  45. :  REF-ERROR IF 87 THROW THEN ;
  46. :  #OPER-ERROR  SWAP IF H. 94 THROW THEN DROP ;
  47.  
  48. 0x2E 1Op1 CS:
  49. 0x3E 1Op1 DS:
  50. 0x26 1Op1 ES:
  51. 0x64 1Op1 FS:
  52. 0x65 1Op1 GS:
  53. 0x36 1Op1 SS:
  54. : IFIND ( c-addr --> xt -1 | c-addr 0 )
  55.    DUP  COUNT CONTEXT @ SEARCH-WORDLIST
  56.    IF   NIP -1
  57.    ELSE 0
  58.    THEN  ;
  59.  
  60. 0 VALUE *OpcSize
  61. 0 VALUE *OpCode
  62. 0 VALUE *Mod
  63. 0 VALUE *Reg
  64. 0 VALUE *R/M
  65. 0 VALUE *Scale
  66. 0 VALUE *Index
  67. 0 VALUE *Base
  68. 0 VALUE *OpSize
  69. 0 VALUE *ImSize
  70. 0 VALUE *AdSize
  71. 0 VALUE *Imm
  72. 0 VALUE *OfSize
  73. 0 VALUE *Offset
  74. 0 VALUE *SegReg
  75. 0 VALUE *OpArray
  76. 0 VALUE *OfRel
  77. 0 VALUE *OpRel
  78. CREATE *OffName 256 ALLOT
  79. CREATE *ImmName 256 ALLOT
  80. CREATE *GenName 256 ALLOT
  81.  
  82. : (OthSz) ( n1 --> n2 )   6 XOR ;
  83.  
  84. : *OpSize>DEF *OpSize 4 = IF *DefDatasz TO *OpSize THEN ;
  85.  
  86. : (Seg) ( --> )
  87.    *SegReg CASE
  88.     0 OF ES: ENDOF
  89.     1 OF CS: ENDOF
  90.     2 OF SS: ENDOF
  91.     3 OF DS: ENDOF
  92.     4 OF FS: ENDOF
  93.     5 OF GS: ENDOF
  94.            ENDCASE
  95. ;
  96.  
  97. : CompileCommand ( --> )
  98.    *OpcSize IF
  99.     *AdSize *DefDatasz (OthSz) = IF 0x67 C, THEN
  100.     *OpSize *DefDatasz (OthSz) = IF 0x66 C, THEN
  101.     *SegReg 0< IFNOT (Seg) THEN
  102.     *OpCode HERE ! *OpcSize ALLOT
  103.     *Mod 0< IFNOT *Mod 3 AND 0x40 * *Reg 7 AND 8 * *R/M 7 AND OR OR C, THEN
  104.     *Scale 0< *Mod 0< OR IFNOT
  105.      *Scale 3 AND 0x40 * *Index 7 AND 8 * *Base 7 AND OR OR C,
  106.     THEN
  107.     *OfRel IF
  108.      *OfSize *DefDatasz <> IF 0x54 THROW THEN
  109.      *OffName C@ IFNOT 1 *OffName 1+ C! THEN
  110.      *OffName 1+ C@ IF *OffName HERE 2 AddStrObject
  111.      ELSE
  112.       *OffName C@ 1- *OffName 1+ C!
  113.       *OffName 1+ HERE 5 AddStrObject
  114.      THEN
  115.     THEN
  116.     *Offset HERE ! *OfSize ALLOT
  117.     *OpRel IF
  118.      *ImSize *DefDatasz <> IF 0x55 THROW THEN
  119.      *ImmName C@ IFNOT 1 *ImmName 1+ C! THEN
  120.      *ImmName 1+ C@ IF *ImmName HERE 2 AddStrObject
  121.      ELSE
  122.       *ImmName C@ 1- *ImmName 1+ C!
  123.       *ImmName 1+ HERE 5 AddStrObject
  124.      THEN
  125.     THEN
  126.     *Imm HERE ! *ImSize ALLOT
  127.    THEN
  128. ;
  129. : InitCommand ( --> )
  130.    0 TO *OpcSize 0 TO *AdSize 0 TO *OpSize 0 TO *ImSize 0 TO *OfSize
  131.    0 TO *OfRel 0 TO *OpRel 0 TO *Offset 0 TO *Imm -1 TO *SegReg -1 TO *Mod
  132.    -1 TO *Scale -1 TO *Base -1 TO *Index *OffName 0! *ImmName 0! *GenName 0!
  133. ;
  134.  
  135. : GetOp ( --> c-addr|char|n type )
  136.    (GetOp) CASE
  137.     1 OF
  138.       1+ C@ DUP [CHAR] ; = IF SOURCE >IN ! 2DROP NullString 0 ELSE 1 THEN
  139.      ENDOF
  140.     2 OF
  141.       BASE @ >R
  142.       DUP C@ OVER + C@ CASE
  143.        [CHAR] H OF 16 BASE ! DUP 1-! ENDOF
  144.        [CHAR] B OF 2 BASE ! DUP 1-! ENDOF
  145.        [CHAR] O OF 8 BASE ! DUP 1-! ENDOF
  146.        [CHAR] D OF 10 BASE ! DUP 1-! ENDOF
  147.             ENDCASE
  148.       VAL 0= IF 0x61 THROW THEN DROP R> BASE ! 2
  149.      ENDOF
  150.     4 OF COUNT ConvertString OVER 1- C! 1- 4 ENDOF
  151.     5 OF COUNT ConvertString OVER 1- C! 1- 5 ENDOF
  152. \       HEX
  153.      DUP
  154. \    [ HERE DROP ]
  155.    ENDCASE
  156. ;
  157.  
  158. : SCopy ( c-addr1 c-addr2 --> )
  159.    OVER C@ 1+ CMOVE
  160. ;
  161.  
  162. : ?Reg8 ( --> n true | false )
  163.    IN>R GetOp 3 = IF
  164.     C" AL" S= 0 ?S=
  165.     C" CL" S= 1 ?S=
  166.     C" DL" S= 2 ?S=
  167.     C" BL" S= 3 ?S=
  168.     C" AH" S= 4 ?S=
  169.     C" CH" S= 5 ?S=
  170.     C" DH" S= 6 ?S=
  171.     C" BH" S= 7 ?S=
  172.    THEN
  173.    DROP FALSE R>IN
  174. ;
  175. : ?Reg16 ( --> n true | FALSE )
  176.    IN>R GetOp 3 = IF
  177.     C" AX" S= 0 ?S=
  178.     C" CX" S= 1 ?S=
  179.     C" DX" S= 2 ?S=
  180.     C" BX" S= 3 ?S=
  181.     C" SP" S= 4 ?S=
  182.     C" BP" S= 5 ?S=
  183.     C" SI" S= 6 ?S=
  184.     C" DI" S= 7 ?S=
  185.    THEN
  186.    DROP FALSE R>IN
  187. ;
  188. : ?Reg32 ( --> n true | FALSE )
  189.    IN>R GetOp 3 = IF
  190.     C" EAX" S= 0 ?S=
  191.     C" ECX" S= 1 ?S=
  192.     C" EDX" S= 2 ?S=
  193.     C" EBX" S= 3 ?S=
  194.     C" ESP" S= 4 ?S=
  195.     C" EBP" S= 5 ?S=
  196.     C" ESI" S= 6 ?S=
  197.     C" EDI" S= 7 ?S=
  198.    THEN
  199.    DROP FALSE R>IN
  200. ;
  201. : ?SegReg ( --> n true | FALSE )
  202.    IN>R GetOp 3 = IF
  203.     C" ES" S= 0 ?S=
  204.     C" CS" S= 1 ?S=
  205.     C" SS" S= 2 ?S=
  206.     C" DS" S= 3 ?S=
  207.     C" FS" S= 4 ?S=
  208.     C" GS" S= 5 ?S=
  209.    THEN
  210.    DROP FALSE R>IN
  211. ;
  212. : SEG ( --> )
  213.    ?SegReg 0= IF 104 THROW THEN (Seg)
  214. ;
  215. : (?Ptr_) ( --> n true | FALSE )
  216.    IN>R GetOp 3 = IF
  217.     C" DWORD" S= 4 ?S=
  218.     C" BYTE"  S= 1 ?S=
  219.     C" WORD"  S= 2 ?S=
  220.    THEN
  221.    DROP FALSE R>IN
  222. ;
  223.  
  224. ' (?Ptr_) ->VECT (?Ptr)
  225. : ?Ptr ( --> flag )
  226.    (?Ptr) IF
  227.     *OpSize IF *OpSize <> IF 0x50 THROW THEN ELSE TO *OpSize THEN
  228.     IN>R GetOp 3 = IF
  229.      C" PTR" S= IF RDROP TRUE EXIT ELSE DROP THEN
  230.     ELSE DROP THEN
  231.     R>IN TRUE
  232.    ELSE FALSE THEN
  233. ;
  234. : ?FWord ( ? --> ? )
  235.    IN>R GetOp 3 = IF
  236.     C" FWORD" S= IF
  237.      RDROP IN>R GetOp 3 = IF
  238.       C" PTR" S= IF RDROP ELSE R>IN DROP THEN
  239.      ELSE R>IN DROP THEN TRUE EXIT
  240.     ELSE DROP FALSE THEN
  241.    ELSE DROP FALSE THEN R>IN
  242. ;
  243. : ?Reg ( --> flag )
  244.    ?Reg32 IF
  245.     *OpSize 1 2 BETWEEN IF 0x50 THROW THEN 4 TO *OpSize TO *Reg TRUE
  246.    ELSE
  247.     ?Reg8 IF
  248.      *OpSize 2 4 BETWEEN IF 0x50 THROW THEN 1 TO *OpSize TO *Reg TRUE
  249.     ELSE
  250.      ?Reg16 IF
  251.       *OpSize 4 = *OpSize 1 = OR IF 0x50 THROW THEN 2 TO *OpSize TO *Reg TRUE
  252.      ELSE FALSE THEN
  253.     THEN
  254.    THEN
  255. ;
  256. : Comma ( --> )
  257.    GetOp 1 = IF [CHAR] , = ?EXIT THEN  0x51 THROW
  258. ;
  259. : ?Colon ( --> flag )
  260.    IN>R GetOp 1 = IF [CHAR] : = ELSE DROP FALSE THEN
  261.    DUP IF RDROP ELSE R>IN THEN
  262. ;
  263. : ?Bracket[ ( --> flag )
  264.    IN>R GetOp 1 = IF [CHAR] [ = IF RDROP TRUE EXIT THEN
  265.    ELSE DROP THEN R>IN FALSE
  266. ;
  267. : (?Label) ( --> addr|0 TRUE | FALSE )
  268.    IN>R GetOp DUP 3 = IF
  269.     DROP DUP 1 FindStrObject IF RDROP NIP TRUE
  270.     ELSE
  271.      RDROP \ DUP FIND IF
  272. \      SWAP >R DUP >Name Off_Attr + @ 0x1000000 AND IF  \ IF PUBLIC
  273. \       RDROP EXECUTE TRUE
  274. \      ELSE
  275. \       *GenName C@ REF-ERROR R> *GenName SCopy DROP 0 TRUE
  276. \      THEN
  277. \     ELSE
  278.     (  DROP ) *GenName C@ REF-ERROR *GenName SCopy 0 TRUE
  279. \     THEN
  280.     THEN
  281.    ELSE
  282.     DUP 1 = IF
  283.      DROP [CHAR] $ = IF RDROP HERE TRUE
  284.      ELSE R>IN FALSE THEN
  285.     ELSE
  286.      4 = IF
  287.       *GenName C@ REF-ERROR
  288.       *GenName 1+ SCopy *GenName 1+ C@ 1+ *GenName W! RDROP 0 TRUE
  289.      ELSE DROP R>IN FALSE THEN
  290.     THEN
  291.    THEN
  292. ;
  293. : 'XFA ( --> cfa )
  294.    GetOp 3 5 BETWEEN IF
  295.     CONTEXT @ >R PREVIOUS FIND ALSO R> CONTEXT !
  296.     0= IF 0x64 THROW THEN
  297.    ELSE   0x63 THROW THEN
  298. ;
  299. : ?Label ( --> addr|0 TRUE | FALSE )
  300.    IN>R GetOp
  301. \       DUP 1 =
  302. \    IF DROP [CHAR] { =
  303. \       IF    RDROP [CHAR] } PARSE EVALUATE TRUE
  304. \       ELSE  R>IN FALSE
  305. \       THEN  EXIT
  306. \    ELSE
  307.      3 = IF
  308.        C" OFFSET" S= IF RDROP (?Label) 0= IF 0x5D THROW THEN  TRUE EXIT
  309.                      THEN
  310.           C" CFA" S= IF RDROP 'XFA TRUE EXIT THEN
  311.           C" PFA" S= IF RDROP 'XFA >BODY TRUE EXIT THEN
  312.           C" NFA" S= IF RDROP 'XFA >NAME TRUE EXIT THEN
  313.      THEN
  314. \   THEN
  315.    DROP R>IN (?Label)
  316. ;
  317.  
  318. : ?Number ( --> n TRUE | FALSE )
  319.    IN>R GetOp CASE
  320.     2 OF TRUE RDROP ENDOF
  321.     1 OF DUP
  322.       [CHAR] { = IF DROP  [CHAR] } PARSE EVALUATE TRUE RDROP ELSE
  323.       [CHAR] - = IF GetOp 2 = IF NEGATE TRUE RDROP
  324.                     ELSE DROP FALSE R>IN THEN       ELSE
  325.       FALSE R>IN THEN THEN
  326.      ENDOF
  327.     5 OF DUP C@ IF 1+ C@ ELSE DROP 0 THEN TRUE RDROP ENDOF
  328.     3 OF 7 FindStrObject IF RDROP TRUE ELSE FALSE R>IN THEN ENDOF
  329.     2DROP FALSE DUP R>IN
  330.    ENDCASE
  331. ;
  332. VARIABLE *Sign
  333. : Imm ( --> )
  334.    *Sign 0! 0 TO *Imm 0 TO *OpRel *GenName 0!
  335.    BEGIN
  336.     ?Number IF
  337. \     *Sign @ IF -To *Imm ELSE +To *Imm THEN
  338.      *Sign @ IF NEGATE THEN  *Imm + TO *Imm
  339.     ELSE
  340.      ?Label IF
  341.       *GenName C@ IF
  342.        *ImmName C@ REF-ERROR *GenName *ImmName SCopy
  343.        *Sign @ REF-ERROR *GenName 0!
  344.       THEN
  345. \      *Sign @ IF 1-To *OpRel -To *Imm ELSE 1+To *OpRel +To *Imm THEN
  346.       *Sign @ IF   *OpRel 1- TO *OpRel NEGATE
  347.               ELSE *OpRel 1+ TO *OpRel
  348.               THEN  *Imm + TO *Imm
  349.      ELSE
  350.       GetOp IF 0x59 ELSE 0x66 THEN THROW
  351.      THEN
  352.     THEN
  353.     *OpRel 0 1 BETWEEN 0= REF-ERROR
  354.     *OpRel IF
  355.      *OpSize 1 =
  356.      *OpSize *DefDatasz (OthSz) = OR IF 0x50 THROW THEN
  357.      *DefDatasz TO *OpSize
  358.     THEN
  359.     GetOp DUP 1 > REF-ERROR
  360.     IF
  361.      CASE
  362.       [CHAR] + OF *Sign 0! FALSE ENDOF
  363.       [CHAR] - OF *Sign ON FALSE ENDOF
  364.       [CHAR] , OF TRUE >IN 1-! ENDOF
  365.         0x59 THROW
  366.      ENDCASE
  367.     ELSE DROP TRUE THEN
  368.    UNTIL
  369.    *OpRel IF *DefDatasz TO *ImSize EXIT THEN
  370.    *OpSize CASE
  371.     1 OF *Imm -256 AND IF 0x5A THROW THEN 1 TO *ImSize ENDOF
  372.     2 OF
  373. \      *Imm -65536 AND IF 0x5A THROW THEN
  374.       *Imm -128 AND DUP 0= SWAP -128 = OR IF 1 ELSE 2 THEN TO *ImSize
  375.      ENDOF
  376.     4 OF
  377.       *Imm -128 AND DUP 0= SWAP -128 = OR IF 1 ELSE 4 THEN TO *ImSize
  378.      ENDOF
  379.     DROP *Imm -32768 AND DUP 0= SWAP -32768 = OR
  380.     IF 0x5C THROW THEN
  381.      *DefDatasz TO *OpSize *DefDatasz TO *ImSize
  382.     DUP
  383.    ENDCASE
  384. ;
  385. : Mult ( n1 --> n2 )
  386.    CASE
  387.     1 OF 0 ENDOF
  388.     2 OF 1 ENDOF
  389.     4 OF 2 ENDOF
  390.     8 OF 3 ENDOF
  391.     TRUE IF 0x58 THROW THEN
  392.    ENDCASE
  393. ;
  394.  
  395. 0 VALUE *OldReg
  396. : ?MemReg ( --> flag )
  397.    *Reg ?Reg IF
  398.     *Reg TO *R/M TO *Reg 3 TO *Mod
  399.    ELSE
  400.     DROP ?Ptr *Sign ! *SegReg TO *OldReg IN>R
  401.     ?SegReg IF
  402.      TO *SegReg
  403.      ?Colon IFNOT
  404.       *Sign @ IF 82 THROW THEN *OldReg TO *SegReg R>IN FALSE EXIT
  405.      THEN
  406.      *Sign ON
  407.     THEN
  408.     RDROP ?Bracket[ DUP *Sign @ OR *Sign !
  409.     *Sign @ IFNOT DROP FALSE EXIT THEN
  410.     0= IF 0x56 THROW THEN *Sign 0! 0 TO *Offset
  411.     BEGIN
  412.      ?Reg32 IF
  413.       *Sign @ REF-ERROR
  414.       *AdSize 2 = IF 0x50 THROW THEN 4 TO *AdSize IN>R
  415.       GetOp 1 = SWAP [CHAR] * = AND IF
  416.        *Index 0< 0= REF-ERROR
  417.        GetOp 2 <> REF-ERROR
  418.        Mult TO *Scale TO *Index RDROP
  419.        *Index 4 = REF-ERROR
  420.       ELSE
  421.        R>IN *Base 0< IFNOT
  422.         *Index 0< 0= REF-ERROR
  423.         0 TO *Scale *Base TO *Index
  424.         *Index 4 = REF-ERROR
  425.        THEN TO *Base
  426.       THEN
  427.      ELSE
  428.       ?Reg16 IF
  429.        *Sign @ REF-ERROR
  430.        *AdSize 4 = IF 0x50 THROW THEN
  431.        2 TO *AdSize
  432.        CASE
  433.         3 OF *Base  0< 0= REF-ERROR 3 TO *Base ENDOF
  434.         5 OF *Base  0< 0= REF-ERROR 5 TO *Base ENDOF
  435.         6 OF *Index 0< 0= REF-ERROR 6 TO *Index ENDOF
  436.         7 OF *Index 0< 0= REF-ERROR 7 TO *Index ENDOF
  437.         TRUE REF-ERROR
  438.        ENDCASE
  439.       ELSE
  440.        ?Number IF
  441.         *AdSize IFNOT *DefDatasz TO *AdSize THEN
  442.         *Sign @ IF NEGATE *Offset + TO *Offset
  443.         ELSE
  444.          IN>R GetOp 1 = SWAP [CHAR] * = AND IF
  445.           *Index 0< 0= REF-ERROR
  446.           ?Reg32 0= REF-ERROR
  447.           TO *Index Mult TO *Scale RDROP
  448.           *Index 4 = REF-ERROR
  449.          ELSE R>IN *Offset + TO *Offset THEN
  450.         THEN
  451.        ELSE
  452.         ?Label IF
  453.          *AdSize 2 = IF 0x50 THROW THEN
  454.          *DefDatasz TO *AdSize
  455.          *GenName C@ IF
  456.           *OffName C@ REF-ERROR
  457.           *GenName *OffName SCopy
  458.           DUP HERE <> IF *Sign @ REF-ERROR THEN *GenName 0!
  459.          THEN
  460.          *Sign @ IF   *OfRel 1- TO *OfRel NEGATE
  461.                  ELSE *OfRel 1+ TO *OfRel THEN *Offset + TO *Offset
  462.         ELSE  89 THROW THEN
  463.        THEN
  464.       THEN
  465.      THEN
  466.      *OfRel 0 1 BETWEEN 0= REF-ERROR
  467.      GetOp 1 <> REF-ERROR
  468.      CASE
  469.       [CHAR] + OF *Sign 0! FALSE ENDOF
  470.       [CHAR] - OF *Sign ON FALSE ENDOF
  471.       [CHAR] ] OF TRUE ENDOF
  472.        89 THROW
  473.      ENDCASE
  474.     UNTIL
  475.    THEN
  476.    *OfSize IFNOT
  477.     *Offset IF
  478.      *Offset 127 > *Offset -128 < OR IF
  479.       *DefDatasz TO *OfSize
  480.       *AdSize 2 = IF
  481.        *Offset 32767 > *Offset -32768 < OR
  482.        IF  91 THROW
  483.        ELSE 2 TO *OfSize
  484.        THEN
  485.       THEN
  486.      ELSE 1 TO *OfSize THEN
  487.     THEN
  488.    THEN
  489.    *OfRel IF *DefDatasz TO *OfSize THEN
  490.    *AdSize *DefDatasz = IF
  491.     *Base 0< IF
  492.      0 TO *Mod
  493.      *Index 0< IF 5 TO *R/M ELSE 4 TO *R/M 5 TO *Base THEN
  494.      *DefDatasz TO *OfSize
  495.     ELSE
  496.      *OfSize 4 = IF 2 ELSE *OfSize THEN TO *Mod
  497.      *Base 5 = *Mod 0= AND IF 0 TO *Offset 1 TO *Mod 1 TO *OfSize THEN
  498.      *Index 0< IF
  499.       *Base 4 = IF 0 TO *Scale 4 TO *Index 4 TO *R/M THEN
  500.       *Base TO *R/M
  501.      ELSE 4 TO *R/M THEN
  502.     THEN
  503.    ELSE
  504.     *AdSize 2 = IF
  505.      *OfSize TO *Mod
  506.      *Base 6 = *Index 0< *OfSize 0= AND AND IF
  507.       1 TO *Mod 0 TO *Offset 1 TO *OfSize
  508.      THEN
  509.      *Base CASE
  510.       3 OF
  511.         *Index CASE
  512.          6 OF 0 ENDOF
  513.          7 OF 1 ENDOF
  514.          DROP 7 DUP
  515.         ENDCASE
  516.        ENDOF
  517.       5 OF
  518.         *Index CASE
  519.          6 OF 2 ENDOF
  520.          7 OF 3 ENDOF
  521.          DROP 6 DUP
  522.         ENDCASE
  523.        ENDOF
  524.         *Index CASE
  525.          6 OF 4 ENDOF
  526.          7 OF 5 ENDOF
  527.          DROP 0 TO *Mod 2 TO *OfSize 6 DUP
  528.         ENDCASE
  529.      ENDCASE
  530.      TO *R/M
  531.     THEN
  532.    THEN TRUE
  533. ;
  534. ALSO S_ASSEM DEFINITIONS PREVIOUS
  535.  
  536. : FCALL ( --> )
  537.   0xE8 C,              \ ¬ è¨­­ ï ª®¬ ­¤  CALL
  538.   ' HERE CELL+ - , ;
  539.  
  540. : FOR
  541.  CONTEXT @ >R PREVIOUS
  542.  INTERPRET
  543.  ALSO  R> CONTEXT ! ;
  544.  
  545. : EQU ( --> )
  546.    LSP @ C@ 1 =
  547.    LSP @ 3 + @
  548.    HERE \  *DefDatasz 2 = IF 0xFFFF AND   THEN
  549.     = AND IF
  550.     InitCommand  *DefDatasz TO *OpSize
  551.     Imm *Imm LSP @ 3 + !
  552.     *OpRel IFNOT 7 LSP @ C! THEN
  553.    ELSE 93 THROW THEN
  554. ;
  555.  
  556. : DD ( --> )
  557.    BEGIN
  558.     InitCommand 4 TO *OpSize
  559.     Imm 4 TO *ImSize
  560.     *OpRel IF *DefDatasz 4 <> REF-ERROR
  561.      *ImSize 4 <> IF 85 THROW THEN
  562.      *ImmName C@ IFNOT 1 *ImmName 1+ C! THEN
  563.      *ImmName 1+ C@ IF *ImmName HERE 2 AddStrObject
  564.      ELSE
  565.       *ImmName C@ 1- *ImmName 1+ C!
  566.       *ImmName 1+ HERE 5 AddStrObject
  567.      THEN
  568.     THEN
  569.     *Imm ,
  570.     IN>R GetOp 1 = SWAP [CHAR] , = AND IF RDROP FALSE
  571.     ELSE R>IN TRUE THEN
  572.    UNTIL
  573. ;
  574.  
  575. : DW ( --> )
  576.    BEGIN
  577.     InitCommand 4 TO *OpSize
  578.     Imm *OpRel REF-ERROR
  579.     2 TO *OpSize 2 TO *ImSize
  580. \    *Imm -65536 AND DUP 0= SWAP -65536 = OR 0= IF 0x5A THROW THEN
  581.     *Imm W,
  582.     IN>R GetOp 1 = SWAP [CHAR] , = AND IF RDROP FALSE
  583.     ELSE R>IN TRUE THEN
  584.    UNTIL
  585. ;
  586.  
  587. : DS ( --> )
  588.    InitCommand 4 TO *OpSize
  589.    Imm 4 TO *ImSize
  590.    *OpRel IF 101 THROW THEN
  591.    HERE *Imm DUP ALLOT ERASE
  592. ;
  593. : DB ( --> )
  594.    BEGIN
  595.     InitCommand
  596.     IN>R GetOp 1 INVERT AND 4 = IF
  597.      RDROP COUNT ?DUP IF HERE SWAP DUP ALLOT CMOVE ELSE DROP THEN
  598.     ELSE
  599.         DROP R>IN 4 TO *OpSize
  600.         Imm *OpRel REF-ERROR
  601.         1 TO *OpSize
  602.         *Imm -128 AND DUP 0= SWAP -128 = OR *Imm 256 U< OR 0=
  603.         IF 0x5A THROW THEN
  604.         *Imm C,
  605.     THEN
  606.     IN>R GetOp 1 = SWAP [CHAR] , = AND IF RDROP FALSE
  607.     ELSE R>IN TRUE THEN
  608.    UNTIL
  609. ;
  610. HIDDEN DEFINITIONS
  611. 0 VALUE ?ENDCODE
  612.  
  613. : DEF+! ( N ADDR -- )
  614.  *DefDatasz 4 = IF +!  ELSE DUP>R @ + R> W!  THEN ;
  615.  
  616. : DEF! ( N ADDR -- )
  617.  *DefDatasz 4 = IF  !  ELSE              W!  THEN ;
  618.  
  619. : ENDCODE ( 0x5030F8 --> )
  620.    TRUE TO ?ENDCODE
  621.    PREVIOUS  0x5030F8 ?PAIRS LSP @ >R
  622.    BEGIN
  623.    R@ C@ WHILE
  624.     R@ C@ 5 = IF
  625.      NullString R@ 3 + @ 2 AddStrObject
  626.      R@ 7 + 9 FindStrObject IF
  627.       R@ 3 + @ DEF+! 10 R@ C!
  628.      ELSE
  629.       HERE R@ 3 + @ DEF+! HERE R@ 3 + !
  630.       R@ 8 + HERE R@ 7 + C@ DUP ALLOT CMOVE 9 R@ C!
  631.      THEN
  632.     THEN
  633.     R@ 1+ W@ R> + >R
  634.    REPEAT
  635.    RDROP  LSP @ >R
  636.    BEGIN
  637.    R@ C@ WHILE
  638.     R@ C@ 8 = IF
  639.      NullString R@ 3 + @ 2 AddStrObject
  640.      NullString HERE 2 AddStrObject
  641.      HERE R@ 3 + @ DEF! R@ 7 + @ ,
  642.     THEN
  643.     R@ 1+ W@ R> + >R
  644.    REPEAT
  645.    RDROP  LSP @ >R
  646.    BEGIN
  647.    R@ C@ WHILE
  648.     R@ C@ 2 = IF
  649.      R@ 7 + C@ IF
  650.       R@ 7 + 1 FindStrObject IF
  651.        R@ 3 + @ DEF+! 0 R@ 7 + C!
  652.       ELSE
  653. \       R@ 7 + >ASCIIZ 0x21 - ErrNo ! 0x53 Error
  654.        ."  ASM: Label not found:" R@ 7 + COUNT TYPE ERR_
  655.       THEN
  656.      THEN
  657. \     R@ 3 + @ LAST @ Name> - RMark
  658.     ELSE
  659.      R@ C@ 4 = IF
  660.       R@ 7 + 1 FindStrObject IF
  661.        R@ 3 + @ - 1- DUP -128 AND DUP 0= SWAP -128 = OR IF
  662.         R@ 3 + @ C!
  663.        ELSE  96 THROW THEN
  664.       ELSE
  665. \       R@ 7 + >ASCIIZ 0x21 - ErrNo ! 0x53 Error
  666.        ."  ASM: Label not found:" R@ 7 + COUNT TYPE ERR_
  667.       THEN
  668.      ELSE
  669.       R@ C@ 3 = IF
  670.        R@ 7 + 1 FindStrObject IF
  671.         R@ 3 + @ - *DefDatasz - R@ 3 + @ DEF!
  672.        ELSE
  673. \        R@ 7 + >ASCIIZ 0x21 - ErrNo ! 0x53 Error
  674.        ."  ASM: Label not found:" R@ 7 + COUNT TYPE ERR_
  675.        THEN
  676.       THEN
  677.      THEN
  678.     THEN
  679.     R@ 1+ W@ R> + >R
  680.    REPEAT
  681.    RDROP ( Save-Input) LSP @ >R
  682.    BEGIN
  683.    R@ C@ WHILE
  684.     R@ C@ 6 = IF
  685.      R@ 7 + 1 FindStrObject IF
  686. \      R@ 7 + COUNT SetStream VALUE 5 RMark Public
  687.      ELSE
  688.       R@ 7 + 7 FindStrObject IF
  689. \       R@ 7 + COUNT SetStream VALUE Public
  690.       ELSE
  691. \       R@ 7 + >ASCIIZ 0x21 - ErrNo ! 0x62 Error
  692.        ." ASM: Unresolved PUBLIC reference:  R@ 7 + COUNT TYPE ERR_
  693.       THEN
  694.      THEN
  695.     THEN
  696.     R@ 1+ W@ R> + >R
  697.    REPEAT
  698.    RDROP ( Restore-Input DROP )
  699. ;
  700.  
  701. :  STARTCODE ( -- )
  702.   ALSO S_ASSEM FALSE TO  ?ENDCODE
  703.    LSP @ >R 0x5030F8 0 >L
  704.    BEGIN
  705.     BEGIN
  706.     GetOp DUP WHILE
  707.      DUP 3 = IF
  708.       DROP IFIND IF
  709.         EXECUTE
  710.           ?ENDCODE IF
  711.             R> LSP ! EXIT
  712.           THEN
  713.       ELSE
  714.        *GenName SCopy GetOp 1 = SWAP [CHAR] : = AND IF
  715.         *GenName 1 FindStrObject IF
  716. \         *GenName >ASCIIZ 0x21 - ErrNo ! 0x5F Error
  717.          ."  ASM: Label already defined:"  R@ 7 + COUNT TYPE ERR_
  718.         ELSE *GenName HERE \ *DefDatasz 2 =  IF 0xFFFF AND  THEN
  719.              1 AddStrObject THEN
  720.        ELSE  -321 THROW THEN
  721.       THEN
  722.      ELSE
  723.       1 = IF
  724.        [CHAR] [ = IF
  725.         [CHAR] ] WORD COUNT EVALUATE
  726.        ELSE  -321 THROW  THEN
  727.       ELSE  -321 THROW  THEN
  728.      THEN
  729.     REPEAT
  730.     2DROP REFILL 0= ABORT" endcode not found"
  731.    AGAIN
  732. ;
  733.  
  734. : PUBLIC ( --> )
  735.    BEGIN
  736.     GetOp 3 = IF 0 6 AddStrObject ELSE 0x5D THROW THEN
  737.     IN>R GetOp 1 = SWAP [CHAR] , = AND IF RDROP FALSE
  738.     ELSE R>IN TRUE THEN
  739.    UNTIL
  740. ;
  741. : 2Op ( name ( c1opc c1reg ... c9opc c9reg --> )
  742.              ( --> )
  743.   \ One-byte opcodes only, but with possible "reg" modIFier
  744.    CREATE 9 0 DO SWAP C, C, LOOP
  745. DOES>
  746.    TO *OpArray InitCommand 1 TO *OpcSize
  747.    ?Reg IF
  748.     Comma ?MemReg IF
  749.      *OpSize  CASE
  750.       1 OF *OpArray 2+ ENDOF
  751.       2 OF *OpArray ENDOF
  752.       4 OF *OpArray ENDOF
  753.       0x5C THROW
  754.      ENDCASE
  755.     ELSE
  756.      3 TO *Mod *Reg TO *R/M
  757.      Imm  *OpSize
  758.        CASE
  759.       1 OF
  760.         *OpArray
  761.         *Reg IF 12 ELSE -1 TO *Mod -1 TO *Scale 0 TO *OfSize 16 THEN +
  762.         DUP 1+ C@ TO *Reg
  763.        ENDOF
  764.       2 OF
  765.         *OpArray
  766.         *Reg IF *ImSize 1 = IF 8 ELSE 10 THEN
  767.         ELSE -1 TO *Mod -1 TO *Scale 0 TO *OfSize *OpSize TO *ImSize 14 THEN +
  768.         DUP 1+ C@ TO *Reg
  769.        ENDOF
  770.  
  771.       4 OF
  772.         *OpArray
  773.         *Reg *ImSize 1 = OR IF *ImSize 1 = IF 8 ELSE 10 THEN
  774.         ELSE -1 TO *Mod -1 TO *Scale 0 TO *OfSize *OpSize TO *ImSize 14 THEN +
  775.         DUP 1+ C@ TO *Reg
  776.        ENDOF
  777.        0x5C THROW
  778.      ENDCASE
  779.     THEN
  780.    ELSE
  781.     ?MemReg 0= IF 94 THROW THEN
  782.     Comma ?Reg IF
  783.      *OpSize CASE
  784.       1 OF *OpArray 6 + ENDOF
  785.       2 OF *OpArray CELL+ ENDOF
  786.       4 OF *OpArray CELL+ ENDOF
  787.       0x5C THROW
  788.      ENDCASE
  789.     ELSE
  790.      Imm *OpSize CASE
  791.       1 OF *OpArray 12 + DUP 1+ C@ TO *Reg ENDOF
  792.       2 OF
  793.         *OpArray *ImSize 1 = IF 8 ELSE 10 THEN + DUP 1+ C@ TO *Reg
  794.        ENDOF
  795.       4 OF
  796.         *OpArray *ImSize 1 = IF 8 ELSE 10 THEN + DUP 1+ C@ TO *Reg
  797.        ENDOF
  798.        0x5C THROW
  799.      ENDCASE
  800.     THEN
  801.    THEN
  802.    C@ DUP TO *OpCode 0xF7 = IF *OpSize TO *ImSize THEN
  803.    CompileCommand
  804. ;
  805. : PUSH ( --> )
  806.    InitCommand
  807.    ?MemReg IF
  808.     1 TO *OpcSize
  809.     *OpSize 2 < IF 0x50 THROW THEN
  810.     *Mod 3 = IF -1 TO *Mod *R/M 0x50 + TO *OpCode
  811.     ELSE 0xFF TO *OpCode 6 TO *Reg THEN
  812.    ELSE
  813.     ?SegReg IF
  814.      CASE
  815.       0 OF 1 0x06 ENDOF
  816.       1 OF 1 0x0E ENDOF
  817.       2 OF 1 0x16 ENDOF
  818.       3 OF 1 0x1E ENDOF
  819.       4 OF 2 0xA00F ENDOF
  820.       5 OF 2 0xA80F ENDOF
  821.       DUP
  822.      ENDCASE
  823.      TO *OpCode TO *OpcSize
  824.     ELSE
  825.      *DefDatasz TO *OpSize Imm 1 TO *OpcSize
  826.      *ImSize 4 = *Imm -32768 AND DUP 0= SWAP -32768 = OR AND *OpRel 0= AND
  827.      IF 2 TO *ImSize THEN
  828.      *ImSize TO *OpSize
  829.      *ImSize 1 = IF 0x6A ELSE 0x68 THEN TO *OpCode
  830.     THEN
  831.    THEN
  832.    CompileCommand
  833. ;
  834.  
  835. : POP ( --> )
  836.    InitCommand
  837.    ?MemReg IF
  838.     1 TO *OpcSize
  839.     *OpSize 2 <  IF 0x50 THROW THEN
  840.     *Mod  3 = IF -1 TO *Mod *R/M  0x58 + TO *OpCode
  841.     ELSE 0x8F TO *OpCode 0 TO *Reg THEN
  842.    ELSE
  843.     ?SegReg IF
  844.      CASE
  845.       0 OF 1 0x07 ENDOF
  846.       1 OF TRUE 1 #OPER-ERROR ENDOF
  847.       2 OF 1 0x17 ENDOF
  848.       3 OF 1 0x1F ENDOF
  849.       4 OF 2 0xA10F ENDOF
  850.       5 OF 2 0xA90F ENDOF
  851.       DUP
  852.      ENDCASE
  853.      TO *OpCode TO *OpcSize
  854.     ELSE  92 THROW THEN
  855.    THEN  
  856.    CompileCommand
  857. ;
  858.  
  859. : IncDec ( name ( byte_opc b_reg word_opc w_reg reg_baseopc dummy --> )
  860.                 ( --> )
  861.   \ One-byte opcodes only, but with possible "reg" modIFier
  862.    CREATE 3 0 DO SWAP C, C, LOOP
  863. DOES>
  864.    TO *OpArray InitCommand
  865.    ?MemReg IF
  866.     *OpSize 0= IF 92 THROW THEN
  867.     1 TO *OpcSize
  868.     *Mod 3 = *OpSize 1 > AND IF -1 TO *Mod *OpArray C@ *R/M +
  869.     ELSE *OpSize 1 = IF 4 ELSE 2 THEN *OpArray + DUP 1+ C@ TO *Reg C@ THEN
  870.     TO *OpCode
  871.    ELSE TRUE 2 #OPER-ERROR THEN
  872.    CompileCommand
  873. ;
  874. : NegNot ( name ( byte_opc b_reg word_opc w_reg --> )
  875.                 ( --> )
  876.   \ One-byte opcodes only, but with possible "reg" modIFier
  877.    CREATE 2 0 DO SWAP C, C, LOOP
  878. DOES>
  879.    TO *OpArray InitCommand
  880.    ?MemReg IF
  881.     *OpSize 0= IF 92 THROW THEN
  882.     1 TO *OpcSize
  883.     *OpArray *OpSize 1 = IF 2 + THEN DUP 1+ C@ TO *Reg C@ TO *OpCode
  884.    ELSE TRUE 3 #OPER-ERROR THEN
  885.    CompileCommand
  886. ;
  887. : MOV ( --> )  
  888.    InitCommand 1 TO *OpcSize
  889.    ?MemReg IF
  890.     Comma *Mod 3 = IF
  891.      *R/M TO *Reg -1 TO *Mod
  892.      ?MemReg IF
  893.       *Reg 0= *Mod 0= *R/M 5 = AND AND IF
  894.        -1 TO *Mod *OpSize 1 = IF 0xA0 ELSE 0xA1 THEN
  895.       ELSE
  896.        *OpSize 1 = IF 0x8A ELSE 0x8B THEN
  897.       THEN
  898.      ELSE
  899.       ?SegReg IF
  900.        *OpSize 2 < IF 0x50 THROW THEN
  901.        *Reg TO *R/M 3 TO *Mod TO *Reg 0x8C
  902.       ELSE
  903.        Imm *OpSize TO *ImSize
  904.        *Reg *OpSize 1 = IF 0xB0 ELSE 0xB8 THEN +
  905.       THEN
  906.      THEN
  907.     ELSE
  908.      ?Reg  IF
  909.       *Reg  0= *Mod 0= *R/M 5 =  AND AND  IF
  910.        -1 TO *Mod *OpSize 1 = IF 0xA2 ELSE 0xA3 THEN
  911.       ELSE
  912.        *OpSize 1 = IF 0x88 ELSE 0x89 THEN
  913.       THEN
  914.      ELSE
  915.       Imm *OpSize TO *ImSize 0 TO *Reg
  916.       *OpSize 1 = IF 0xC6 ELSE 0xC7 THEN
  917.      THEN
  918.     THEN
  919.    ELSE
  920.     ?SegReg IF
  921.      Comma TO *Reg
  922.      ?MemReg IF *DefDatasz TO *OpSize 0x8E ELSE TRUE 4 #OPER-ERROR THEN
  923.     ELSE TRUE 5 #OPER-ERROR THEN
  924.    THEN
  925.    TO *OpCode CompileCommand
  926. ;
  927. : INT ( --> )
  928.    InitCommand 1 TO *OpSize
  929.    Imm *Imm 3 = IF 0xCC C, ELSE 0xCD C, *Imm C, THEN
  930. ;
  931. : OUT ( --> )
  932.    InitCommand
  933.    ?Reg IF
  934.     *Reg 2 = *OpSize 2 = AND IF
  935.      Comma InitCommand
  936.      ?Reg IF
  937.       *Reg IF TRUE 6 #OPER-ERROR THEN
  938.       *OpSize CASE
  939.        1 OF 0xEE C, ENDOF
  940.        2 OF 0xEF66 W, ENDOF
  941.        4 OF 0xEF C, ENDOF
  942.        DUP
  943.       ENDCASE
  944.      ELSE TRUE 7 #OPER-ERROR THEN
  945.     ELSE TRUE 8 #OPER-ERROR THEN
  946.    ELSE
  947.     1 TO *OpSize Imm Comma *Imm >R InitCommand
  948.     ?Reg IF
  949.      *Reg IF TRUE 9 #OPER-ERROR THEN
  950.       *OpSize CASE
  951.        1 OF 0xE6 C, ENDOF
  952.        2 OF 0xE766 W, ENDOF
  953.        4 OF 0xE7 C, ENDOF
  954.        DUP
  955.       ENDCASE
  956.     ELSE TRUE 10 #OPER-ERROR THEN
  957.     R> C,
  958.    THEN
  959. ;
  960. : IN ( --> )
  961.    InitCommand
  962.    ?Reg IF *Reg  11 #OPER-ERROR ELSE TRUE 12 #OPER-ERROR THEN
  963.    Comma *OpSize >R InitCommand
  964.    ?Reg IF
  965.     *Reg 2 = *OpSize 2 = AND 0= 13 #OPER-ERROR
  966.     R> CASE
  967.      1 OF 0xEC C, ENDOF
  968.      2 OF 0xED66 W, ENDOF
  969.      4 OF 0xED C, ENDOF
  970.      DUP
  971.     ENDCASE
  972.    ELSE
  973.     1 TO *OpSize Imm
  974.     R> CASE
  975.      1 OF 0xE4 C, ENDOF
  976.      2 OF 0xE566 W, ENDOF
  977.      4 OF 0xE5 C, ENDOF
  978.      DUP
  979.     ENDCASE
  980.     *Imm C,
  981.    THEN
  982. ;
  983. : LxS ( name ( opcode opcsize --> )
  984.              ( --> )
  985.    CREATE C, W,
  986. DOES>
  987.    InitCommand
  988.    DUP C@ TO *OpcSize 1+ W@ TO *OpCode
  989.    ?Reg IF
  990.     *OpSize TO *OpArray
  991.     Comma *OpSize 2 < IF 0x50 THROW THEN
  992.     *OpSize 2 = *OpCode 0x8D = OR IF  \ Opcode 8D belongs TO LEA
  993.      *OpCode 0x8D = IF 0 ELSE 4 THEN TO *OpSize
  994.      ?MemReg IF
  995.       *Mod 3 = 14 #OPER-ERROR
  996.       *OpCode 0x8D = IF *OpArray ELSE 2 THEN TO *OpSize
  997.      ELSE TRUE 15 #OPER-ERROR THEN
  998.     ELSE
  999.      ?Ptr IF 0x50 THROW THEN
  1000.      ?FWord DROP *DefDatasz TO *OpSize
  1001.      ?MemReg IF *Mod 3 = 16 #OPER-ERROR
  1002.      ELSE TRUE 17 #OPER-ERROR THEN
  1003.     THEN
  1004.    ELSE TRUE 18 #OPER-ERROR THEN
  1005.    CompileCommand
  1006. ;
  1007. : JShort ( --> )
  1008.    *OpArray C@ 0= 19 #OPER-ERROR
  1009.    *DefDatasz TO *OpSize
  1010.    Imm *ImmName C@ IF
  1011.     *OpArray 1+ W@ HERE ! *OpArray C@ ALLOT
  1012.     *ImmName HERE 4 AddStrObject
  1013.     0 C,
  1014.    ELSE
  1015.     *Imm HERE 2+ - -128 AND DUP 0= SWAP -128 = OR IF
  1016.      *Imm HERE 2+ - *OpArray 1+ W@ HERE ! *OpArray C@ ALLOT C,
  1017.     ELSE 96 THROW THEN
  1018.    THEN
  1019. ;
  1020. : Jxx ( name ( indir_opcsize i_opc i_reg near_sze n_opc short_sz s_opc --> )
  1021.              ( --> )
  1022.    CREATE SWAP C, W, SWAP C, W, ROT C, SWAP W, C,
  1023. DOES>
  1024.    TO *OpArray
  1025.    InitCommand
  1026.    IN>R GetOp 3 = IF C" SHORT" S= IF RDROP JShort EXIT THEN THEN DROP R>IN
  1027.    0 TO *AdSize
  1028.    ?MemReg IF
  1029.     *OpArray 6 + C@ ?DUP IF TO *OpcSize ELSE 20 #OPER-ERROR THEN
  1030.     *OpArray 7 + W@ TO *OpCode *OpArray 9 + C@ TO *Reg
  1031.     CompileCommand EXIT
  1032.    THEN
  1033.    *DefDatasz TO *OpSize
  1034.    Imm  *OpSize>DEF *OpArray C@ *OpArray 3 + C@ OR 0=  21 #OPER-ERROR
  1035.    *ImmName C@ IF
  1036.     *OpArray 3 + C@ IF
  1037.      *OpArray CELL+ W@ HERE ! *OpArray 3 + C@ ALLOT
  1038.      *ImmName HERE 3 AddStrObject 0 *DefDatasz 4 = IF , ELSE W, THEN
  1039.     ELSE
  1040.      *OpArray 1+ W@ HERE ! *OpArray C@ ALLOT
  1041.      *ImmName HERE 4 AddStrObject 0 C,
  1042.     THEN
  1043.    ELSE
  1044. \    *Imm 0x100 KernelSize + LAST @ Name> BETWEEN IF
  1045. \     0 TO *OpRel *OffName 0! *ImmName 0! 0 TO *ImSize 0 TO *Offset 4 TO *OfSize
  1046. \     4 TO *AdSize -1 TO *Base -1 TO *Index -1 TO *Scale 5 TO *R/M 0 TO *Mod
  1047. \     *OpArray 6 + C@ ?DUP 0= ABORT" ASM: External address reference not allowed"
  1048. \     TO *OpcSize
  1049. \     *OpArray 7 + W@ TO *OpCode *OpArray 9 + C@ TO *Reg
  1050. \     *Imm HERE *OpcSize + 1+ 8 AddNumObject
  1051. \     CompileCommand EXIT
  1052. \    THEN
  1053.     *OpArray C@ *Imm HERE 2+ - -128 AND DUP 0= SWAP -128 = OR AND IF
  1054.      *Imm HERE 1+ *OpArray C@ + - *OpArray 1+ W@ HERE ! *OpArray C@ ALLOT C,
  1055.     ELSE
  1056.      *OpArray 3 + C@ IF
  1057.       *Imm HERE *DefDatasz 4 = IF CELL+ THEN *OpArray 3 + C@ + -
  1058.       *OpArray CELL+ W@ HERE ! *OpArray 3 + C@ ALLOT
  1059.       *DefDatasz 4 = IF , ELSE W, THEN
  1060.      ELSE 96 THROW THEN
  1061.     THEN
  1062.    THEN
  1063. ;
  1064. : ShIFt ( name ( reg --> )
  1065.                ( --> )
  1066.   \ Hardcoded opcodes - "reg" modIFiers only
  1067.    CREATE C,
  1068. DOES>
  1069.    InitCommand
  1070.    C@ TO *Reg
  1071.    ?MemReg IF
  1072.     Comma ?Reg8 IF
  1073.      1 <> 22 #OPER-ERROR
  1074.      *OpSize 1 = IF 0xD2 ELSE 0xD3 THEN
  1075.     ELSE
  1076.      Imm *Imm 0xFF U> IF 90 THROW THEN
  1077.      *Imm 1 = IF
  1078.       *OpSize 1 = IF 0xD0 ELSE 0xD1 THEN 0 TO *ImSize
  1079.      ELSE
  1080.       *OpSize 1 = IF 0xC0 ELSE 0xC1 THEN 1 TO *ImSize
  1081.      THEN
  1082.     THEN
  1083.    ELSE TRUE 23 #OPER-ERROR THEN
  1084.    TO *OpCode 1 TO *OpcSize
  1085.    CompileCommand
  1086. ;
  1087. : XCHG ( --> )
  1088.    InitCommand
  1089.    ?MemReg IF
  1090.     Comma *Mod 3 = IF
  1091.      -1 TO *Mod *R/M TO *Reg
  1092.      ?MemReg IF
  1093.       *Mod 3 = *R/M 0= *Reg 0= OR AND *OpSize 1 > AND IF
  1094.        *OpSize 2 = IF 0x66 C, THEN
  1095.        0x90 *Reg + *R/M + C, EXIT
  1096.       THEN
  1097.      ELSE TRUE 24 #OPER-ERROR THEN
  1098.     ELSE
  1099.      ?Reg 0=  25 #OPER-ERROR
  1100.     THEN
  1101.    ELSE 25 #OPER-ERROR THEN
  1102.    *OpSize 1 = IF 0x86 ELSE 0x87 THEN TO *OpCode 1 TO *OpcSize
  1103.    CompileCommand
  1104. ;
  1105. : IMUL ( --> )
  1106.    InitCommand
  1107.    ?MemReg IF
  1108.     IN>R GetOp 1 = SWAP [CHAR] , = AND IF
  1109.      RDROP *Mod 3 <> 26 #OPER-ERROR
  1110.      *OpSize 1 > 0= 27 #OPER-ERROR
  1111.      *R/M TO *Reg -1 TO *Mod
  1112.      ?MemReg IF
  1113.       IN>R GetOp 1 = SWAP [CHAR] , = AND IF
  1114.        RDROP Imm 1 TO *OpcSize
  1115.        *ImSize 1 = IF 0x6B ELSE 0x69 THEN TO *OpCode
  1116.       ELSE
  1117.        R>IN 0xAF0F TO *OpCode 2 TO *OpcSize
  1118.       THEN
  1119.      ELSE
  1120.       Imm 3 TO *Mod *Reg TO *R/M 1 TO *OpcSize
  1121.       *ImSize 1 = IF 0x6B ELSE 0x69 THEN TO *OpCode
  1122.      THEN
  1123.     ELSE
  1124.      R>IN *OpSize 1 = IF 0xF6 ELSE 0xF7 THEN TO *OpCode 1 TO *OpcSize 5 TO *Reg
  1125.     THEN
  1126.    ELSE TRUE 28 #OPER-ERROR THEN
  1127.    CompileCommand
  1128. ;
  1129. : MOVxx ( name ( opc1 opc2 --> )
  1130.                ( --> )
  1131.   \ Two-byte opcodes only
  1132.    CREATE W, W,
  1133. DOES>
  1134.    InitCommand
  1135.    TO *OpArray 2 TO *OpcSize
  1136.    ?Reg IF
  1137.     *OpSize >R 0 TO *OpSize
  1138.     Comma ?MemReg IF
  1139.      *OpSize 4 = IF 0x50 THROW THEN
  1140.      *OpSize 2 = R> TO *OpSize IF
  1141.       *OpSize 4 <> IF 0x50 THROW THEN
  1142.       *OpArray W@ TO *OpCode
  1143.      ELSE *OpArray 2+ W@ TO *OpCode THEN
  1144.     ELSE TRUE 29 #OPER-ERROR THEN
  1145.    ELSE TRUE 29 #OPER-ERROR THEN
  1146.    CompileCommand
  1147. ;
  1148. : Bit ( name ( c1opc c1reg c2opc c2reg --> )
  1149.              ( --> )
  1150.   \ Two-byte opcodes only, with possible "reg" modIFier
  1151.    CREATE SWAP W, C, SWAP W, C,
  1152. DOES>
  1153.    InitCommand
  1154.    TO *OpArray 2 TO *OpcSize
  1155.    ?MemReg IF
  1156.     *OpSize 2 < 30 #OPER-ERROR
  1157.     Comma ?Reg IF *OpArray 3 +
  1158.     ELSE
  1159.      Imm *Imm 0xFF > IF 90 THROW THEN
  1160.      1 TO *ImSize *OpArray 2+ C@ TO *Reg *OpArray
  1161.     THEN
  1162.     W@ TO *OpCode
  1163.    ELSE TRUE 31 #OPER-ERROR THEN
  1164.    CompileCommand
  1165. ;
  1166. : SETxx ( name ( opc --> )
  1167.                ( --> )
  1168.   \ Two-byte opcodes only
  1169.    CREATE W,
  1170. DOES>
  1171.    InitCommand
  1172.    W@ TO *OpCode 2 TO *OpcSize
  1173.    ?MemReg IF
  1174.     *OpSize 1 <>  33 #OPER-ERROR
  1175.     0 TO *Reg
  1176.    ELSE TRUE 34 #OPER-ERROR THEN
  1177.    CompileCommand
  1178. ;
  1179. : SHxD ( name ( opc1 opc2 --> )
  1180.               ( --> )
  1181.   \ Two-byte opcodes only
  1182.    CREATE W, W,
  1183. DOES>
  1184.    InitCommand
  1185.    TO *OpArray 2 TO *OpcSize
  1186.    ?MemReg IF
  1187.     *OpSize 2 < 0= 35 #OPER-ERROR
  1188.     Comma ?Reg IF
  1189.      Comma ?Reg8 IF 1 <> 36 #OPER-ERROR *OpArray
  1190.      ELSE Imm *Imm 0xFF > IF 90 THROW THEN *OpArray 2+ THEN
  1191.     ELSE TRUE 37 #OPER-ERROR THEN
  1192.    ELSE TRUE 38 #OPER-ERROR THEN
  1193.    W@ TO *OpCode
  1194.    CompileCommand
  1195. ;
  1196. : BSx ( name ( WORD --> )
  1197.              ( --> )
  1198.    CREATE W,
  1199. DOES>
  1200.    InitCommand W@ TO *OpCode 2 TO *OpcSize
  1201.    ?Reg IF
  1202.     *OpSize 2 <  39 #OPER-ERROR
  1203.     Comma ?MemReg 0= TRUE 40 #OPER-ERROR
  1204.    ELSE TRUE 41 #OPER-ERROR THEN
  1205.    CompileCommand
  1206. ;
  1207. : Rxx ( name ( opc --> )
  1208.              ( --> )
  1209.    CREATE C, DOES> C@ C, 1 C, 0xC3 C,
  1210. ;
  1211. : ALIGN ( --> )
  1212.    InitCommand *DefDatasz TO *OpSize Imm 4 TO *ImSize
  1213.    *OpRel IF 101 THROW THEN
  1214.    BEGIN
  1215.     HERE *Imm MOD WHILE
  1216.     0 C,
  1217.    REPEAT
  1218. ;
  1219.  
  1220. : I'  BL WORD  IFIND 0= IF -321 THROW THEN (  -? ) ;
  1221.  
  1222. ALSO S_ASSEM DEFINITIONS
  1223.  
  1224. S" ~mak\asm\ASM_SIF.F" INCLUDED
  1225.  
  1226. 0xC9 1Op1 LEAVE
  1227. 0xCC 1Op1 INT3
  1228. 0xCE 1Op1 INTO
  1229. 0x37 1Op1 AAA
  1230. 0x3F 1Op1 AAS
  1231. 0x99 1Op1D CDQ
  1232. 0x98 1Op1D CWDE
  1233. 0xF8 1Op1 CLC
  1234. 0xFC 1Op1 CLD
  1235. 0xFA 1Op1 CLI
  1236. 0xF5 1Op1 CMC
  1237. 0xA6 1Op1 CMPSB
  1238. 0xA7 1Op1D CMPSD
  1239. 0x27 1Op1 DAA
  1240. 0x2F 1Op1 DAS
  1241. 0xF4 1Op1 HLT
  1242. 0x6C 1Op1 INSB
  1243. 0x6D 1Op1D INSD
  1244. 0xCF 1Op1D IRETD
  1245. 0x9F 1Op1 LAHF
  1246. 0xAC 1Op1 LODSB
  1247. 0xAD 1Op1D LODSD
  1248. 0xA4 1Op1 MOVSB
  1249. 0xA5 1Op1D MOVSD
  1250. 0x90 1Op1 NOP
  1251. 0x6E 1Op1 OUTSB
  1252. 0x6F 1Op1D OUTSD
  1253. 0x61 1Op1D POPAD
  1254. 0x60 1Op1D PUSHAD
  1255. 0x9D 1Op1D POPFD
  1256. 0x9C 1Op1D PUSHFD
  1257. 0xC3 1Op1 RET
  1258. 0xCB 1Op1 RETF
  1259. 0x9E 1Op1 SAHF
  1260. 0xAE 1Op1 SCASB
  1261. 0xAF 1Op1D SCASD
  1262. 0xF9 1Op1 STC
  1263. 0xFD 1Op1 STD
  1264. 0xFB 1Op1 STI
  1265. 0xAA 1Op1 STOSB
  1266. 0xAB 1Op1D STOSD
  1267. 0x9B 1Op1 WAIT
  1268. 0xD7 1Op1 XLAT
  1269. 0xD7 1Op1 XLATB
  1270. 0xF0 1Op1 LOCK
  1271. 0xF3 1Op1 REP
  1272. 0xF3 1Op1 REPE
  1273. 0xF3 1Op1 REPZ
  1274. 0xF2 1Op1 REPNE
  1275. 0xF2 1Op1 REPNZ
  1276. 0x0AD5 1Op2 AAD
  1277. 0x0AD4 1Op2 AAM
  1278. 0x310F 1Op2 RDTSC
  1279. 0x98 1Op1W CBW
  1280. 0x99 1Op1W CWD
  1281. 0xA7 1Op1W CMPSW
  1282. 0x6D 1Op1W INSW
  1283. 0xCF 1Op1W IRET
  1284. 0xAD 1Op1W LODSW
  1285. 0xA5 1Op1W MOVSW
  1286. 0x6F 1Op1W OUTSW
  1287. 0x61 1Op1W POPA
  1288. 0x60 1Op1W PUSHA
  1289. 0x9D 1Op1W POPF
  1290. 0x9C 1Op1W PUSHF
  1291. 0xAF 1Op1W SCASW
  1292. 0xAB 1Op1W STOSW
  1293. 0x14 0 0x15 0 0x80 2 0x81 2 0x83 2 0x10 0 0x11 0 0x12 0 0x13 0 2Op ADC
  1294. 0x04 0 0x05 0 0x80 0 0x81 0 0x83 0 0x00 0 0x01 0 0x02 0 0x03 0 2Op ADD
  1295. 0x24 0 0x25 0 0x80 4 0x81 4 0x83 4 0x20 0 0x21 0 0x22 0 0x23 0 2Op AND
  1296. 0x3C 0 0x3D 0 0x80 7 0x81 7 0x83 7 0x38 0 0x39 0 0x3A 0 0x3B 0 2Op CMP
  1297. 0x1C 0 0x1D 0 0x80 3 0x81 3 0x83 3 0x18 0 0x19 0 0x1A 0 0x1B 0 2Op SBB
  1298. 0x2C 0 0x2D 0 0x80 5 0x81 5 0x83 5 0x28 0 0x29 0 0x2A 0 0x2B 0 2Op SUB
  1299. 0x34 0 0x35 0 0x80 6 0x81 6 0x83 6 0x30 0 0x31 0 0x32 0 0x33 0 2Op XOR
  1300. 0x0C 0 0x0D 0 0x80 1 0x81 1 0x83 1 0x08 0 0x09 0 0x0A 0 0x0B 0 2Op OR
  1301. 0xA8 0 0xA9 0 0xF6 0 0xF7 0 0xF7 0 0x84 0 0x85 0 0x84 0 0x85 0 2Op TEST
  1302. 0xFE 0 0xFF 0 0x40 0 IncDec INC
  1303. 0xFE 1 0xFF 1 0x48 0 IncDec DEC
  1304. 0xF6 3 0xF7 3 NegNot NEG
  1305. 0xF6 2 0xF7 2 NegNot NOT
  1306. 0xF6 4 0xF7 4 NegNot MUL
  1307. 0xF6 6 0xF7 6 NegNot DIV
  1308. 0xF6 7 0xF7 7 NegNot IDIV
  1309. 0x8D 1 LxS LEA
  1310. 0xC5 1 LxS LDS
  1311. 0xC4 1 LxS LES
  1312. 0xB20F 2 LxS LSS
  1313. 0xB40F 2 LxS LFS
  1314. 0xB50F 2 LxS LGS
  1315. 1 0xFF 4 1 0xE9 1 0xEB Jxx JMP
  1316. 1 0xFF 2 1 0xE8 0 0 Jxx CALL
  1317. 0 0 0 0 0 1 0xE3 Jxx JECXZ
  1318. 0 0 0 0 0 2 0xE367 Jxx JCXZ
  1319. 0 0 0 0 0 1 0xE2 Jxx LOOP
  1320. 0 0 0 0 0 1 0xE1 Jxx LOOPZ
  1321. 0 0 0 0 0 1 0xE0 Jxx LOOPNZ
  1322. 0 0 0 2 0x840F 1 0x74 Jxx JZ
  1323. 0 0 0 2 0x800F 1 0x70 Jxx JO
  1324. 0 0 0 2 0x810F 1 0x71 Jxx JNO
  1325. 0 0 0 2 0x820F 1 0x72 Jxx JC
  1326. 0 0 0 2 0x830F 1 0x73 Jxx JNC
  1327. 0 0 0 2 0x850F 1 0x75 Jxx JNZ
  1328. 0 0 0 2 0x860F 1 0x76 Jxx JNA
  1329. 0 0 0 2 0x870F 1 0x77 Jxx JA
  1330. 0 0 0 2 0x880F 1 0x78 Jxx JS
  1331. 0 0 0 2 0x890F 1 0x79 Jxx JNS
  1332. 0 0 0 2 0x8A0F 1 0x7A Jxx JPE
  1333. 0 0 0 2 0x8B0F 1 0x7B Jxx JPO
  1334. 0 0 0 2 0x8C0F 1 0x7C Jxx JL
  1335. 0 0 0 2 0x8D0F 1 0x7D Jxx JGE
  1336. 0 0 0 2 0x8E0F 1 0x7E Jxx JLE
  1337. 0 0 0 2 0x8F0F 1 0x7F Jxx JG
  1338. : JE JZ ;
  1339. : JB JC ;
  1340. : JNAE JC ;
  1341. : JAE JNC ;
  1342. : JNB JNC ;
  1343. : JNE JNZ ;
  1344. : JBE JNA ;
  1345. : JNBE JA ;
  1346. : JP JPE ;
  1347. : JNP JPO ;
  1348. : JNGE JL ;
  1349. : JNL JGE ;
  1350. : JNG JLE ;
  1351. : JNLE JG ;
  1352. : LOOPE LOOPZ ;
  1353. : LOOPNE LOOPNZ ;
  1354. 0x02 ShIFt RCL
  1355. 0x03 ShIFt RCR
  1356. 0x00 ShIFt ROL
  1357. 0x01 ShIFt ROR
  1358. 0x04 ShIFt SAL
  1359. 0x07 ShIFt SAR
  1360. 0x04 ShIFt SHL
  1361. 0x05 ShIFt SHR
  1362. 0xBE0F 0xBF0F MOVxx MOVSX
  1363. 0xB60F 0xB70F MOVxx MOVZX
  1364. 0 0xA30F 4 0xBA0F Bit BT
  1365. 0 0xBB0F 7 0xBA0F Bit BTC
  1366. 0 0xB30F 6 0xBA0F Bit BTR
  1367. 0 0xAB0F 5 0xBA0F Bit BTS
  1368. 0x970F SETxx SETA
  1369. 0x930F SETxx SETAE
  1370. 0x920F SETxx SETC
  1371. 0x960F SETxx SETNA
  1372. 0x940F SETxx SETZ
  1373. 0x9F0F SETxx SETG
  1374. 0x9D0F SETxx SETGE
  1375. 0x9C0F SETxx SETL
  1376. 0x9E0F SETxx SETLE
  1377. 0x950F SETxx SETNZ
  1378. 0x900F SETxx SETO
  1379. 0x910F SETxx SETNO
  1380. 0x980F SETxx SETS
  1381. 0x990F SETxx SETNS
  1382. 0x9A0F SETxx SETP
  1383. 0x9B0F SETxx SETNP
  1384. : SETNBE SETA ;
  1385. : SETNB SETAE ;
  1386. : SETNC SETAE ;
  1387. : SETB SETC ;
  1388. : SETNAE SETC ;
  1389. : SETBE SETNA ;
  1390. : SETE SETZ ;
  1391. : SETNLE SETG ;
  1392. : SETNL SETGE ;
  1393. : SETNGE SETL ;
  1394. : SETNG SETLE ;
  1395. : SETNE SETNZ ;
  1396. : SETPE SETP ;
  1397. : SETPO SETNP ;
  1398. 0xA40F 0xA50F SHxD SHLD
  1399. 0xAC0F 0xAD0F SHxD SHRD
  1400. 0xBC0F BSx BSF
  1401. 0xBD0F BSx BSR
  1402. 0x73 Rxx RC
  1403. 0x72 Rxx RNC
  1404. 0x75 Rxx RZ
  1405. 0x74 Rxx RNZ
  1406. 0x76 Rxx RA
  1407. 0x77 Rxx RNA
  1408. 0x7A Rxx RPO
  1409. 0x7B Rxx RPE
  1410. 0x71 Rxx RO
  1411. 0x70 Rxx RNO
  1412. 0x7E Rxx RG
  1413. 0x7F Rxx RNG
  1414. 0x7D Rxx RL
  1415. 0x7C Rxx RNL
  1416. : RE RZ ;
  1417. : RB RC ;
  1418. : RNAE RC ;
  1419. : RAE RNC ;
  1420. : RNB RNC ;
  1421. : RNE RNZ ;
  1422. : RBE RNA ;
  1423. : RNBE RA ;
  1424. : RP RPE ;
  1425. : RNP RPO ;
  1426. : RNGE RL ;
  1427. : RGE RNL ;
  1428. : RLE RNG ;
  1429. : RNLE RG ;
  1430.  
  1431. PREVIOUS
  1432.  
  1433. ALSO FORTH DEFINITIONS
  1434.  
  1435. :  Code ( -- )
  1436.    HEADER  STARTCODE ;
  1437.  
  1438. : STARTCODE STARTCODE ;
  1439.  
  1440. : USE16 ( --> )
  1441.    2 TO *DefDatasz
  1442. ;
  1443. : USE32 ( --> )
  1444.    4 TO *DefDatasz
  1445. ;
  1446.  
  1447. S_ASSEM DEFINITIONS
  1448.  
  1449. : MOVSD 0xA5  C,  *DefDatasz 2 = IF 0x66 C, THEN ;
  1450. : MOVSW 0xA5  C,  *DefDatasz 4 = IF 0x66 C, THEN ;
  1451.  
  1452. : SEG SEG ;
  1453. : PUBLIC PUBLIC ;
  1454. : ENDCODE ENDCODE ;
  1455. : PUSH PUSH ;
  1456. : POP POP ;
  1457. : MOV MOV ;
  1458. : INT INT ;
  1459. : OUT OUT ;
  1460. : IN IN ;
  1461. : XCHG XCHG ;
  1462. : IMUL IMUL ;
  1463. : ALIGN ALIGN ;
  1464.  
  1465. PREVIOUS
  1466. PREVIOUS DEFINITIONS
  1467.  
  1468. \EOF
  1469. USE16
  1470. Code ZZ
  1471.  mov      bp, msg
  1472. msg: ; EQU 4444H
  1473.  RET
  1474. ENDCODE
  1475. \EOF
  1476.  
  1477. C" DBG" FIND NIP
  1478. [IF]
  1479.  
  1480. ALSO S_ASSEM
  1481.  mov      Ebp, msg
  1482.  
  1483. USE16
  1484. DBG mov      bp, msg
  1485. [THEN]
  1486. \S
  1487.  
  1488. Code ZZ
  1489.      ADD EBX, {KEY}
  1490.      ADD EBX, 44H
  1491.      ADD EBX, 4444444H
  1492. WWW: MOV EAX, WWW+4
  1493.      MOV EAX, [EBP+EDX*4]
  1494. FOR   0x44444 ,
  1495.      JMP SHORT SS1
  1496. SS1: JMP       SS2
  1497. SS2:
  1498. EndCode
  1499.  
  1500. ' ZZ 20 DUMP
  1501. \ 4B22AE 09C0             OR      EAX , EAX
  1502. \ http://win32asm.chat.ru/