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