cgen/mode.scm

   1 ; Mode objects.
   2 ; Copyright (C) 2000 Red Hat, Inc.
   3 ; This file is part of CGEN.
   4 ; See file COPYING.CGEN for details.
   5
   6 ; FIXME: Later allow target to add new modes.
   7
   8 (define <mode>
   9   (class-make '<mode>
  10               '(<ident>)
  11               '(
  12                 ; One of RANDOM, INT, UINT, FLOAT.
  13                 class
  14
  15                 ; size in bits
  16                 bits
  17
  18                 ; size in bytes
  19                 bytes
  20
  21                 ; NON-MODE-C-TYPE is the C type to use in situations where
  22                 ; modes aren't available.  A somewhat dubious feature, but at
  23                 ; the moment the opcodes tables use it.  It is either the C
  24                 ; type as a string (e.g. "int") or #f for non-portable modes
  25                 ; (??? could use other typedefs for #f, e.g. int64 for DI).
  26                 ; Use of GCC can't be assumed though.
  27                 non-mode-c-type
  28
  29                 ; PRINTF-TYPE is the %<letter> arg to printf-like functions,
  30                 ; however we define our own extensions for non-portable modes.
  31                 ; Values not understood by printf aren't intended to be used
  32                 ; with printf.
  33                 ;
  34                 ; Possible values:
  35                 ; %x - as always
  36                 ; %D - DI mode
  37                 ; %f - SF,DF modes
  38                 ; %F - XF,TF modes
  39                 printf-type
  40
  41                 ; SEM-MODE is the mode to use for semantic operations.
  42                 ; Unsigned modes are not part of the semantic language proper,
  43                 ; but they can be used in hardware descriptions.  This maps
  44                 ; unusable -> usable modes.  It is #f if the mode is usable by
  45                 ; itself.  This prevents circular data structures and makes it
  46                 ; easy to define since the object doesn't exist before it's
  47                 ; defined.
  48                 ; ??? May wish to later remove SEM-MODE (e.g. mips signed add
  49                 ; is different than mips unsigned add) however for now it keeps
  50                 ; things simpler (and prevents being wildly dissimilar from
  51                 ; GCC-RTL.  And the mips case needn't be handled with different
  52                 ; adds anyway.
  53                 sem-mode
  54
  55                 ; PTR-TO, if non-#f, is the mode being pointed to.
  56                 ptr-to
  57
  58                 ; HOST? is non-#f if the mode is a portable int for hosts,
  59                 ; or other host-related value.
  60                 ; This is used for things like register numbers and small
  61                 ; odd-sized immediates and registers.
  62                 ; ??? Not my favorite word choice here, but it's close.
  63                 host?
  64                 )
  65               nil)
  66 )
  67
  68 ; Accessor fns
  69
  70 (define mode:class (elm-make-getter <mode> 'class))
  71 (define mode:bits (elm-make-getter <mode> 'bits))
  72 (define mode:bytes (elm-make-getter <mode> 'bytes))
  73 (define mode:non-mode-c-type (elm-make-getter <mode> 'non-mode-c-type))
  74 (define mode:printf-type (elm-make-getter <mode> 'printf-type))
  75 (define mode:sem-mode (elm-make-getter <mode> 'sem-mode))
  76 ; ptr-to is currently private so there is no accessor.
  77 (define mode:host? (elm-make-getter <mode> 'host?))
  78
  79 ; Return C type to use for values of mode M.
  80
  81 (define (mode:c-type m)
  82   (let ((ptr-to (elm-xget m 'ptr-to)))
  83     (if ptr-to
  84         (string-append (mode:c-type ptr-to) " *")
  85         (obj:name m)))
  86 )
  87
  88 ; CM is short for "concat mode".  It is a list of modes of the elements
  89 ; of a `concat'.
  90 ; ??? Experiment.  Not currently used.
  91
  92 (define <concat-mode>
  93   (class-make '<concat-mode> '(<mode>)
  94               '(
  95                 ; List of element modes
  96                 elm-modes
  97                 )
  98               nil)
  99 )
 100
 101 ; Accessors.
 102
 103 (define cmode-elm-modes (elm-make-getter <concat-mode> 'elm-modes))
 104 \f
 105 ; List of all modes.
 106
 107 (define mode-list nil)
 108
 109 ; Return list of mode objects.
 110 ; Hides the fact that its stored as an alist from caller.
 111
 112 (define (mode-list-values) (map cdr mode-list))
 113
 114 ; Return list of real mode objects (no aliases).
 115
 116 (define (mode-list-non-alias-values)
 117   (map cdr
 118        (find (lambda (m) (eq? (car m) (obj:name (cdr m))))
 119              mode-list))
 120 )
 121
 122 ; Return a boolean indicating if X is a <mode> object.
 123
 124 (define (mode? x) (class-instance? <mode> x))
 125
 126 ; Return enum cgen_mode_types value for M.
 127
 128 (define (mode:enum m)
 129   (gen-c-symbol (string-append "MODE_" (string-upcase (obj:name m))))
 130 )
 131
 132 ; Return a boolean indicating if MODE1 is equal to MODE2
 133 ; Either may be the name of a mode or a <mode> object.
 134 ; Aliases are handled by refering to their real name.
 135
 136 (define (mode:eq? mode1 mode2)
 137   (let ((mode1-name (mode-real-name mode1))
 138         (mode2-name (mode-real-name mode2)))
 139     (eq? mode1-name mode2-name))
 140 )
 141
 142 ; Return a boolean indicating if CLASS is one of INT/UINT.
 143
 144 (define (mode-class-integral? class) (memq class '(INT UINT)))
 145 (define (mode-class-signed? class) (eq? class 'INT))
 146 (define (mode-class-unsigned? class) (eq? class 'UINT))
 147
 148 ; Return a boolean indicating if CLASS is floating point.
 149
 150 (define (mode-class-float? class) (memq class '(FLOAT)))
 151
 152 ; Return a boolean indicating if CLASS is numeric.
 153
 154 (define (mode-class-numeric? class) (memq class '(INT UINT FLOAT)))
 155
 156 ; Return a boolean indicating if MODE has an integral mode class.
 157 ; Similarily for signed/unsigned.
 158
 159 (define (mode-integral? mode) (mode-class-integral? (mode:class mode)))
 160 (define (mode-signed? mode) (mode-class-signed? (mode:class mode)))
 161 (define (mode-unsigned? mode) (mode-class-unsigned? (mode:class mode)))
 162
 163 ; Return a boolean indicating if MODE has a floating point mode class.
 164
 165 (define (mode-float? mode) (mode-class-float? (mode:class mode)))
 166
 167 ; Return a boolean indicating if MODE has a numeric mode class.
 168
 169 (define (mode-numeric? mode) (mode-class-numeric? (mode:class mode)))
 170
 171 ; Return a boolean indicating if MODE1 is compatible with MODE2.
 172 ; MODE[12] are either names or <mode> objects.
 173 ; HOW is a symbol indicating how the test is performed:
 174 ; strict: modes must have same name
 175 ; samesize: modes must be both float or both integer (int or uint) and have
 176 ;           same size
 177 ; sameclass: modes must be both float or both integer (int or uint)
 178 ; numeric: modes must be both numeric
 179
 180 (define (mode-compatible? how mode1 mode2)
 181   (let ((m1 (mode:lookup mode1))
 182         (m2 (mode:lookup mode2)))
 183     (case how
 184       ((strict)
 185        (eq? (obj:name m1) (obj:name m2)))
 186       ((samesize)
 187        (cond ((mode-integral? m1)
 188               (and (mode-integral? m2)
 189                    (= (mode:bits m1) (mode:bits m2))))
 190              ((mode-float? m1)
 191               (and (mode-float? m2)
 192                    (= (mode:bits m1) (mode:bits m2))))
 193              (else #f)))
 194       ((sameclass)
 195        (cond ((mode-integral? m1) (mode-integral? m2))
 196              ((mode-float? m1) (mode-float? m2))
 197              (else #f)))
 198       ((numeric)
 199        (and (mode-numeric? m1) (mode-numeric? m2)))
 200       (else (error "bad `how' arg to mode-compatible?" how))))
 201 )
 202
 203 ; Add MODE named NAME to the list of recognized modes.
 204 ; If NAME is already present, replace it with MODE.
 205 ; MODE is a mode object.
 206 ; NAME exists to allow aliases of modes [e.g. WI, UWI, AI].
 207 ;
 208 ; No attempt to preserve any particular order of entries is done here.
 209 ; That is up to the caller.
 210
 211 (define (mode:add! name mode)
 212   (let ((entry (assq name mode-list)))
 213     (if entry
 214         (set-cdr! entry mode)
 215         (set! mode-list (acons name mode mode-list)))
 216     mode)
 217 )
 218 \f
 219 ; Parse a mode.
 220 ; This is the main routine for building a mode object.
 221 ; All arguments are in raw (non-evaluated) form.
 222
 223 (define (-mode-parse errtxt name comment attrs class bits bytes
 224                     non-mode-c-type printf-type sem-mode ptr-to host?)
 225   (logit 2 "Processing mode " name " ...\n")
 226   (let* ((name (parse-name name errtxt))
 227          (errtxt (string-append errtxt " " name))
 228          (result (make <mode>
 229                        name
 230                        (parse-comment comment errtxt)
 231                        (atlist-parse attrs "mode" errtxt)
 232                        class bits bytes non-mode-c-type printf-type
 233                        sem-mode ptr-to host?)))
 234     result)
 235 )
 236
 237 ; ??? At present there is no define-mode that takes an associative list
 238 ; of arguments.
 239
 240 ; Define a mode object, all arguments specified.
 241
 242 (define (define-full-mode name comment attrs class bits bytes
 243           non-mode-c-type printf-type sem-mode ptr-to host?)
 244   (let ((m (-mode-parse "define-full-mode" name comment attrs
 245                         class bits bytes
 246                         non-mode-c-type printf-type sem-mode ptr-to host?)))
 247     ; Add it to the list of insn modes.
 248     (mode:add! name m)
 249     m)
 250 )
 251 \f
 252 ; Lookup the mode named X.
 253 ; Return the found object or #f.
 254 ; If X is already a mode object, return that.
 255
 256 (define (mode:lookup x)
 257   (if (mode? x)
 258       x
 259       (let ((result (assq x mode-list)))
 260         (if result
 261             (cdr result)
 262             #f)))
 263 )
 264
 265 ; Return a boolean indicating if X is a valid mode name.
 266
 267 (define (mode-name? x)
 268   (and (symbol? x)
 269        ; FIXME: Time to make `mode-list' a hash table.
 270        (->bool (assq x mode-list)))
 271 )
 272
 273 ; Return the name of the real mode of M.
 274 ; This is a no-op unless M is an alias in which case we return the
 275 ; real mode of the alias.
 276
 277 (define (mode-real-name m)
 278   (obj:name (mode:lookup m))
 279 )
 280
 281 ; Return the real mode of M.
 282 ; This is a no-op unless M is an alias in which case we return the
 283 ; real mode of the alias.
 284
 285 (define (mode-real-mode m)
 286   (mode:lookup (mode-real-name m))
 287 )
 288
 289 ; Return #t if mode M1-NAME is bigger than mode M2-NAME.
 290
 291 (define (mode-bigger? m1-name m2-name)
 292   (> (mode:bits (mode:lookup m1-name))
 293      (mode:bits (mode:lookup m2-name)))
 294 )
 295
 296 ; Return a mode in mode class CLASS wide enough to hold BITS.
 297
 298 (define (mode-find bits class)
 299   (let ((modes (find (lambda (mode) (eq? (mode:class (cdr mode)) class))
 300                      mode-list)))
 301     (if (null? modes)
 302         (error "invalid mode class" class))
 303     (let loop ((modes modes))
 304       (cond ((null? modes) (error "no modes for bits" bits))
 305             ((<= bits (mode:bits (cdar modes))) (cdar modes))
 306             (else (loop (cdr modes))))))
 307 )
 308
 309 ; Parse MODE-NAME and return the mode object.
 310 ; An error is signalled if MODE isn't valid.
 311
 312 (define (parse-mode-name mode-name errtxt)
 313   (let ((m (mode:lookup mode-name)))
 314     (if (not m) (parse-error errtxt "not a valid mode" mode-name))
 315     m)
 316 )
 317
 318 ; Make a new INT/UINT mode.
 319 ; These have a variable number of bits (1-32).
 320
 321 (define (mode-make-int bits)
 322   (if (or (<= bits 0) (> bits 64))
 323       (error "unsupported number of bits" bits))
 324   (let ((result (object-copy-top INT)))
 325     (elm-xset! result 'bits bits)
 326     (elm-xset! result 'bytes (bits->bytes bits))
 327     result)
 328 )
 329
 330 (define (mode-make-uint bits)
 331   (if (or (<= bits 0) (> bits 64))
 332       (error "unsupported number of bits" bits))
 333   (let ((result (object-copy-top UINT)))
 334     (elm-xset! result 'bits bits)
 335     (elm-xset! result 'bytes (bits->bytes bits))
 336     result)
 337 )
 338 \f
 339 ; Initialization.
 340
 341 ; Some modes are refered to by the Scheme code.
 342 ; These have global bindings, but we try not to make this the general rule.
 343 ; [Actually I don't think this is all that bad, but it seems reasonable to
 344 ; not create global bindings that we don't have to.]
 345
 346 (define VOID #f)
 347 (define DFLT #f)
 348
 349 ; This is defined by the target.  We provide a default def'n.
 350 (define WI #f)
 351 (define UWI #f)
 352
 353 ; An "address int".  This is recorded in addition to a "word int" because it
 354 ; is believed that some target will need it.  It also stays consistent with
 355 ; what BFD does.
 356 ; This can also be defined by the target.  We provide a default.
 357 (define AI #f)
 358 (define IAI #f)
 359
 360 ; Variable sized portable ints.
 361 (define INT #f)
 362 (define UINT #f)
 363
 364 (define (mode-init!)
 365   (set! mode-list nil)
 366
 367   (reader-add-command! 'define-full-mode
 368                        "\
 369 Define a mode, all arguments specified.
 370 "
 371                        nil '(name commment attrs class bits bytes
 372                              non-c-mode-type printf-type sem-mode ptr-to host?)
 373                        define-full-mode)
 374
 375   *UNSPECIFIED*
 376 )
 377
 378 ; Called before a . cpu file is read in to install any builtins.
 379
 380 (define (mode-builtin!)
 381   ; FN-SUPPORT: In sem-ops.h file, include prototypes as well as macros.
 382   ;             Elsewhere, functions are defined to perform the operation.
 383   (define-attr '(for mode) '(type boolean) '(name FN-SUPPORT))
 384
 385   (let ((dfm define-full-mode))
 386     ; This list must be defined in order of increasing size among each type.
 387
 388     (dfm 'VOID "void" '() 'RANDOM 0 0 "void" "" #f #f #f) ; VOIDmode
 389
 390     ; Special marker to indicate "use the default mode".
 391     ; ??? Not yet used everywhere it should be.
 392     (dfm 'DFLT "default mode" '() 'RANDOM 0 0 "" "" #f #f #f)
 393
 394     ; Not UINT on purpose.
 395     (dfm 'BI "one bit (0,1 not 0,-1)" '() 'INT 1 1 "int" "'x'" #f #f #f)
 396
 397     (dfm 'QI "8 bit byte" '() 'INT 8 1 "int" "'x'" #f #f #f)
 398     (dfm 'HI "16 bit int" '() 'INT 16 2 "int" "'x'" #f #f #f)
 399     (dfm 'SI "32 bit int" '() 'INT 32 4 "int" "'x'" #f #f #f)
 400     (dfm 'DI "64 bit int" '(FN-SUPPORT) 'INT 64 8 "" "'D'" #f #f #f)
 401
 402     (dfm 'UQI "8 bit unsigned byte" '() 'UINT
 403          8 1 "unsigned int" "'x'" (mode:lookup 'QI) #f #f)
 404     (dfm 'UHI "16 bit unsigned int" '() 'UINT
 405          16 2 "unsigned int" "'x'" (mode:lookup 'HI) #f #f)
 406     (dfm 'USI "32 bit unsigned int" '() 'UINT
 407          32 4 "unsigned int" "'x'" (mode:lookup 'SI) #f #f)
 408     (dfm 'UDI "64 bit unsigned int" '(FN-SUPPORT) 'UINT
 409          64 8 "" "'D'" (mode:lookup 'DI) #f #f)
 410
 411     ; Floating point values.
 412     (dfm 'SF "32 bit float" '(FN-SUPPORT) 'FLOAT
 413          32 4 "" "'f'" #f #f #f)
 414     (dfm 'DF "64 bit float" '(FN-SUPPORT) 'FLOAT
 415          64 8 "" "'f'" #f #f #f)
 416     (dfm 'XF "80/96 bit float" '(FN-SUPPORT) 'FLOAT
 417          96 12 "" "'F'" #f #f #f)
 418     (dfm 'TF "128 bit float" '(FN-SUPPORT) 'FLOAT
 419          128 16 "" "'F'" #f #f #f)
 420
 421     ; These are useful modes that represent host values.
 422     ; For INT/UINT the sizes indicate maximum portable values.
 423     ; These are also used for random width hardware elements (e.g. immediates
 424     ; and registers).
 425     ; FIXME: Can't be used to represent both host and target values.
 426     ; Either remove the distinction or add new modes with the distinction.
 427     (dfm 'INT "portable int" '() 'INT 32 4 "int" "'x'"
 428          (mode:lookup 'SI) #f #t)
 429     (dfm 'UINT "portable unsigned int" '() 'UINT 32 4 "unsigned int" "'x'"
 430          (mode:lookup 'SI) #f #t)
 431
 432     ; ??? Experimental.
 433     (dfm 'PTR "host pointer" '() 'RANDOM 0 0 "PTR" "'x'"
 434          #f (mode:lookup 'VOID) #t)
 435     )
 436
 437   (set! VOID (mode:lookup 'VOID))
 438   (set! DFLT (mode:lookup 'DFLT))
 439
 440   (set! INT (mode:lookup 'INT))
 441   (set! UINT (mode:lookup 'UINT))
 442
 443   ; To redefine these, use mode:add! again.
 444   (set! WI (mode:add! 'WI (mode:lookup 'SI)))
 445   (set! UWI (mode:add! 'UWI (mode:lookup 'USI)))
 446   (set! AI (mode:add! 'AI (mode:lookup 'USI)))
 447   (set! IAI (mode:add! 'IAI (mode:lookup 'USI)))
 448
 449   *UNSPECIFIED*
 450 )
 451
 452 (define (mode-finish!)
 453   ; Keep the fields sorted for mode-find.
 454   (set! mode-list (reverse mode-list))
 455
 456   (if #f
 457   ; ???: Something like this would be nice if it was timed appropriately
 458   ; redefine WI/UWI/AI/IAI for this target
 459       (case (cpu-word-bitsize (current-cpu))
 460         ((32) (begin
 461                 (display "Recognized 32-bit cpu.\n")))
 462         ((64) (begin
 463                 (display "Recognized 64-bit cpu.\n")
 464                 (set! WI (mode:add! 'WI (mode:lookup 'DI)))
 465                 (set! UWI (mode:add! 'UWI (mode:lookup 'UDI)))
 466                 (set! AI (mode:add! 'AI (mode:lookup 'UDI)))
 467                 (set! IAI (mode:add! 'IAI (mode:lookup 'UDI)))))
 468         (else (error "Unknown word-bitsize for WI/UWI/AI/IAI mode!"))))
 469
 470   *UNSPECIFIED*
 471 )