level1/05_base_vars.f

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; UrForth level 1: self-hosting 32-bit Forth compiler
   3 ;; Copyright (C) 2020 Ketmar Dark // Invisible Vector
   4 ;; GPLv3 ONLY
   5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   6
   7 $constant "WLIST-HASH-BITS" WLIST_HASH_BITS
   8 $constant "ALIGN-WORD-HEADERS?" URFORTH_ALIGN_HEADERS
   9
  10 $constant "URFORTH-LEVEL" 1
  11
  12 ;; bit 15 is "beta" flag
  13 ;; this gives us versions up to 255.255.32767
  14 $constant "URFORTH-VERSION" 0x00_01_0001
  15
  16 $constant "URFORTH-OS" URFORTH_OS
  17
  18 $constant "URFORTH-OS-LINUX/X86" URFORTH_LINUX_X86
  19 $constant "URFORTH-OS-WIN32" URFORTH_WIN32
  20
  21 ;; should segfault handler throw an error instead of exiting?
  22 $value "(TRAP-THROW)" urfsegfault_throw_error
  23 (hidden)
  24
  25 ;; print stack trace before doing an action?
  26 $value "(TRAP-STACKTRACE)" urfsegfault_stacktrace
  27 (hidden)
  28
  29 ;; is multithreading active?
  30 ;; this will be set to `true` if at least one thread was created
  31 ;; this will never be reset (except in SAVEd images)
  32 $value "(MT-ACTIVE?)" 0
  33 (hidden)
  34
  35
  36 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  37 ;; user area size is 4KB (hardcoded)
  38
  39 ;; user area
  40 $align 16,0
  41 $label ua_default_values
  42   rb  URFORTH_MAX_USERAREA_SIZE
  43
  44 $if URFORTH_TLS_TYPE
  45 ;; will be patched by the startup/thread creation code
  46 ;; it should always be at zero offset
  47 $uservar "(USER-BASE-ADDR)" ua_ofs_baseaddr 0
  48 (hidden)
  49
  50 ;; this will be set by thread creation code
  51 ;; this is the full size of tls+stacks allocation, that can be used in OS:MUNMAP
  52 $uservar "(USER-FULL-SIZE)" ua_ofs_fullsize 0
  53 (hidden)
  54 $endif
  55
  56 ;; patched by the startup code
  57 $uservar "(MAIN-THREAD?)" ua_ofs_is_main_thread 0
  58 (hidden)
  59
  60 $uservar "SP0"  ua_ofs_sp0 0
  61 $uservar "RP0"  ua_ofs_rp0 0
  62 ;; default size for thread stacks (note: main thread has different-sized stacks)
  63 ;; with those sizes, it rougly fits into one 4KB page (including userarea)
  64 $uservar "#SP"  ua_ofs_spsize 500
  65 $uservar "#RP"  ua_ofs_rpsize 240
  66
  67 $uservar "BASE" ua_ofs_base 10
  68
  69 ;; this can be used in various OOP implementations
  70 ;; the kernel doesn't use it
  71 ;; the reason it is there is because THROW will save/restore it
  72 $uservar "(SELF)" ua_ofs_self 0
  73 (hidden)
  74
  75 ;; this can be used in various locals implementations
  76 ;; the kernel doesn't use it (yet)
  77 ;; the reason it is there is because THROW will save/restore it
  78 $uservar "(LOCPTR)" ua_ofs_locptr 0
  79 (hidden)
  80
  81 $uservar "PAD-AREA" ua_ofs_padarea 0
  82
  83 ;; this will be patched by the startup/thread creation code
  84 $uservar "(DEFAULT-TIB)" ua_ofs_deftib 0
  85 (hidden)
  86
  87 $constant "(DEFAULT-#TIB)" 4090
  88 (hidden)
  89
  90 $if URFORTH_TLS_TYPE
  91 ;; default user area values
  92 ;; this will be created and set by the metacompiler
  93 $constant "(USER-AREA-DEFAULT)"  ua_default_values
  94 (hidden)
  95 $constant "(USER-AREA-MAX-SIZE)" URFORTH_MAX_USERAREA_SIZE
  96 (hidden)
  97 $variable "(USER-AREA-USED)"     ur_userarea_default_size
  98 (hidden)
  99
 100 $if URFORTH_TLS_TYPE = URFORTH_TLS_TYPE_FS
 101 $value "(USER-TLS-ENTRY-INDEX)" 0
 102 (hidden)
 103 $endif
 104 $endif
 105
 106 $constant "HAS-TLS?" URFORTH_TLS_TYPE
 107
 108
 109 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 110 ;; pad is allocated with BRK; "#PAD-AREA-RESV" is the space BEFORE "PAD-AREA"
 111 ;; $variable "PAD-AREA" 0  ;; will be set by startup code
 112 $constant "#PAD-AREA-RESV" 2040
 113 $constant "#PAD-AREA" 2048
 114
 115
 116 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 117 ;; optimiser options
 118
 119 ;; optimise branch to branch to branch?
 120 $value "(OPT-BRANCHES?)" 1
 121 (hidden)
 122
 123 ;; should optimiser replace alias calls with aliased words?
 124 ;; this doesn't affect REPLACED words, tho
 125 ;; actually, for this to work, the word size should be exactly 5/8 bytes, and
 126 ;; starts with jmp
 127 $value "(OPT-ALIASES?)" 0
 128 (hidden)
 129
 130 ;; should replaced words be rerouted in the same ways as aliases?
 131 ;; this may break further replacing, so it is turned off
 132 ;; not yet implemented
 133 ;;$value "(OPT-REPLACES?)" 0
 134 ;;(hidden)
 135
 136
 137 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 138 $variable "STATE" 0
 139
 140 $variable "DP" urforth_code_end
 141 (hidden)
 142 $variable "DP-LAST-ADDR" urforth_dict_lastaddr  ;; last valid dictionary address
 143 (hidden)
 144 $variable "DP-PROTECTED" urforth_dict_protected  ;; first unprotected address
 145 (hidden)
 146
 147 ;; this is used to temporarily change HERE
 148 ;; MUST be inside "(DP-TEMP-BASE)", because first dp-temp-base cell is used to check size
 149 $variable "DP-TEMP" 0
 150 (hidden)
 151 $variable "(DP-TEMP-BASE)" 0  ;; first cell is size
 152 (hidden)
 153 $variable "(DP-TEMP-BUF)"  0
 154 (hidden)
 155
 156 ;; voclink always points to another voclink (or contains 0)
 157 $variable "(VOC-LINK)" forth_wordlist_voclink  ;; voclink always points to wordlist voclink (or contains 0)
 158 (hidden)
 159
 160
 161 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 162 ;; BSS reserve on SAVE
 163 $value "(SAVE-BSS-RESERVE)" URFORTH_BSS_RESERVE
 164 (hidden)
 165
 166
 167 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 168 $value "ARGC" 0
 169 $value "ARGV" 0
 170 $value "ENVP" 0
 171
 172
 173 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 174 $constant "HAS-DEBUGGER?" URFORTH_DEBUG
 175 $constant "ALIGN-HEADERS?" URFORTH_ALIGN_HEADERS
 176 $constant "ALIGN-CFA?" URFORTH_ALIGN_CFA
 177 $constant "ALIGN-PFA?" URFORTH_ALIGN_PFA
 178 $constant "(#CFA)" URFORTH_CFA_SIZE
 179 (hidden)
 180
 181 $constant "(CODE-BASE-ADDR)" urforth_code_base_addr
 182 (hidden)
 183
 184 ;; two dwords -- disk and memory
 185 $constant "(ELF-HEADER-CODE-SIZE-ADDR)" elfhead_codesize_addr
 186 (hidden)
 187
 188 $constant "(ELF-DYNAMIC?)" URFORTH_DYNAMIC_BINARY
 189 (hidden)
 190
 191 $if URFORTH_DYNAMIC_BINARY
 192 $constant "(CODE-IMPORTS-ADDR)" elfhead_impstart
 193 (hidden)
 194 ;; in bytes
 195 $constant "(CODE-IMPORTS-SIZE)" elfhead_implen
 196 (hidden)
 197 $endif
 198
 199 $constant "(CODE-ENTRY-ADDR)" urforth_entry_point
 200 (hidden)
 201
 202
 203 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 204 $value "TLOAD-VERBOSE-LIBS" 1
 205 $value "TLOAD-VERBOSE" 0
 206 $value "TLOAD-VERBOSE-DEFAULT" 0
 207 $value "TLOAD-VERBOSE-RC" 0
 208
 209
 210 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 211 ;; moved to "10_litbase.f"
 212 ;; $constant "TRUE"  1
 213 ;; $constant "FALSE" 0
 214
 215 $constant "CELL" 4
 216 $constant "BL" 32
 217 $constant "NL" 10
 218
 219
 220 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 221
 222 ;; all things is this chain will be called before and after saving the image
 223 : (startup-init) ... ; (hidden)
 224
 225 ;; this chain will be executed on abort, to cleanup the things
 226 : (ABORT-CLEANUP)  ( -- )  ... ; (hidden)
 227
 228
 229 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 230 ;; for speed
 231 code: (TLS-BASE-ADDR)  ( -- addr )
 232   push  TOS
 233  $if URFORTH_TLS_TYPE = URFORTH_TLS_TYPE_FS
 234   ld    TOS,ts:[ua_ofs_baseaddr]
 235  $else
 236   xor   TOS,TOS
 237  $endif
 238   urnext
 239 endcode
 240 (hidden)
 241
 242 code: (self@)  ( -- value )
 243   push  TOS
 244   ld    TOS,ts:[ua_ofs_self]
 245   urnext
 246 endcode
 247
 248 code: (self!)  ( value -- )
 249   ld    ts:[ua_ofs_self],TOS
 250   pop   TOS
 251   urnext
 252 endcode
 253
 254 code: (locptr@)  ( -- value )
 255   push  TOS
 256   ld    TOS,ts:[ua_ofs_locptr]
 257   urnext
 258 endcode
 259
 260 code: (locptr!)  ( value -- )
 261   ld    ts:[ua_ofs_locptr],TOS
 262   pop   TOS
 263   urnext
 264 endcode