libs/asmx86/macros/defx.f

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; UrForth level 1: self-hosting 32-bit Forth compiler
   3 ;; Natural-syntax x86 assembler
   4 ;; Modelled after SMAL32 built-in assembler
   5 ;; Copyright (C) 2020 Ketmar Dark // Invisible Vector
   6 ;; GPLv3 ONLY
   7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   8 ;; db/dw/dd
   9 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10
  11 : (defx)  ( size -- )
  12   >r  ;; save size on the rstack
  13   begin
  14     tk-eol?
  15   not-while
  16     ;; string?
  17     tk-str? if
  18       ;; allow strings in any more; they will still be one-byte strings, though
  19       \ r@ 4 = ERRID_ASM_TYPE_MISMATCH not-?asm-error
  20       lexer:tkvalue count over + swap ?do
  21         i c@ 1 asm-n-allot asm-c!
  22       loop
  23       lexer:NextToken
  24     else
  25       Reset-Instruction
  26       r@ to *OpSize
  27       Imm
  28       ;; label?
  29       *OpReloc if
  30         r@ 4 = ERRID_ASM_TYPE_MISMATCH not-?asm-error
  31         ;; signal fixup
  32         *ImmName ccount ( *ImSize ) 4 *ImmForthType asm-Label-Fixup
  33       endif
  34       ;; put value
  35       *Imm
  36       r@ case
  37         1 of $ff and asm-c, endof
  38         2 of $ffff and asm-w, endof
  39         4 of asm-, endof
  40         otherwise ERRID_ASM_INTERNAL_ERROR asm-error
  41       endcase
  42     endif
  43     ExpectCommaOrEOL
  44   repeat
  45   rdrop  ;; drop size
  46 ; (hidden)
  47
  48 : (resx)  ( size -- )
  49   ;; convert size to reserve word cfa
  50   case
  51     1 of ['] asm-c, endof
  52     2 of ['] asm-w, endof
  53     4 of ['] asm-, endof
  54     otherwise ERRID_ASM_INTERNAL_ERROR asm-error
  55   endcase
  56   Get-Imm-Defined
  57   dup 0< ERRID_ASM_INVALID_OPERAND ?asm-error
  58   0 ?do 0 over execute loop
  59   drop  ;; drop cfa
  60 ; (hidden)
  61
  62
  63 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  64 : DB  ( -- )  1 (defx)  ;
  65 : DW  ( -- )  2 (defx)  ;
  66 : DD  ( -- )  4 (defx)  ;
  67
  68 : DEFB  ( -- )  1 (defx)  ;
  69 : DEFW  ( -- )  2 (defx)  ;
  70 : DEFD  ( -- )  4 (defx)  ;
  71
  72
  73 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  74 ;; "reserve" fills with zeroes
  75 : RB  ( -- )  1 (resx)  ;
  76 : RW  ( -- )  2 (resx)  ;
  77 : RD  ( -- )  4 (resx)  ;