OSDN Git Service

* read.scm (/cmd-define-rtl-version): Only log rtl version if changed.
[pf3gnuchains/pf3gnuchains4x.git] / cgen / utils-gen.scm
1 ; Application independent utilities for C/C++ code generation.
2 ; Copyright (C) 2000, 2001, 2005, 2009 Red Hat, Inc.
3 ; This file is part of CGEN.
4 ; See file COPYING.CGEN for details.
5
6 ; Attributes.
7
8 (define (attr-bool-gen-decl attr) "")
9
10 (define (attr-bool-gen-defn attr) "")
11
12 (define (attr-int-gen-decl attr) "")
13
14 (define (attr-int-gen-defn attr) 
15   (string-append
16    "static const CGEN_ATTR_ENTRY " (gen-sym attr)
17    "_attr [] ATTRIBUTE_UNUSED = \n{\n  {\"integer\", " (number->string (attr-default attr)) "},\n  { 0, 0 }\n};\n\n" ))
18
19 (define (attr-gen-decl attr)
20   (gen-enum-decl (symbol-append (obj:name attr) '-attr)
21                  (obj:comment attr)
22                  (string-append (obj:str-name attr) "_")
23                  (attr-values attr))
24 )
25
26 (define (attr-gen-defn attr)
27   (string-append
28    "static const CGEN_ATTR_ENTRY "
29    (gen-sym attr) "_attr"
30    "[] ATTRIBUTE_UNUSED =\n{\n"
31    (string-map (lambda (elm)
32                  (let* ((san (and (pair? elm) (pair? (cdr elm))
33                                   (attr-value (cddr elm) 'sanitize #f))))
34                    (gen-sanitize
35                     (if (and san (not (eq? san 'none)))
36                         san
37                         #f)
38                     (string-append "  { "
39                                    "\""
40                                    (gen-c-symbol (car elm))
41                                    "\", "
42                                    (string-upcase (gen-sym attr))
43                                    "_"
44                                    (string-upcase (gen-c-symbol (car elm)))
45                                    " },\n"))))
46                (attr-values attr))
47    "  { 0, 0 }\n"
48    "};\n\n")
49 )
50
51 (method-make! <boolean-attribute> 'gen-decl attr-bool-gen-decl)
52 (method-make! <bitset-attribute> 'gen-decl attr-gen-decl)
53 (method-make! <integer-attribute> 'gen-decl attr-int-gen-decl)
54 (method-make! <enum-attribute> 'gen-decl attr-gen-decl)
55
56 (method-make! <boolean-attribute> 'gen-defn attr-bool-gen-defn)
57 (method-make! <bitset-attribute> 'gen-defn attr-gen-defn)
58 (method-make! <integer-attribute> 'gen-defn attr-int-gen-defn)
59 (method-make! <enum-attribute> 'gen-defn attr-gen-defn)
60 \f
61 ; Ifield extraction utilities.
62
63 ; Return the C data type to use to hold an extracted and decoded
64 ; <ifield> from an insn.  Usually this is just an int, but for register
65 ; numbers or large unsigned immediates, an unsigned int may be preferable.
66 ; Then there's floats (??? which aren't handled yet).
67
68 (define (gen-ifld-type f)
69   (mode:c-type (ifld-decode-mode f))
70 )
71
72 ; Return C declaration of variable(s) to hold <ifield> F.
73 ; MACRO? is #t if the result is part of a macro.
74
75 (define (gen-ifld-extract-decl f indent macro?)
76   (string-append indent (gen-ifld-type f) " " (gen-sym f) ";"
77                  (if macro? " \\\n" "\n"))
78 )
79
80 ; Return C code to extract a field from the base part of an insn.
81 ;
82 ; TOTAL-LENGTH is the total length of the value in VAL.
83 ; BASE-VALUE is a C expression (string) containing the base part of the insn.
84
85 (define (/gen-ifld-extract-base f total-length base-value)
86   (let ((extraction
87          (string-append "EXTRACT_"
88                         (if (current-arch-insn-lsb0?) "LSB0_" "MSB0_")
89                         (case (mode:class (ifld-mode f))
90                           ((INT) "INT")
91                           ((UINT) "UINT")
92                           (else (error "unsupported mode class"
93                                        (mode:class (ifld-mode f)))))
94                         " ("
95                         base-value ", "
96                         (number->string total-length) ", "
97                         (number->string (+ (ifld-start f)
98                                            (ifld-word-offset f))) ", "
99                         (number->string (ifld-length f))
100                         ")"))
101         (decode (ifld-decode f)))
102     ; If the field doesn't have a special decode expression,
103     ; just return the raw extracted value.  Otherwise, emit
104     ; the expression.
105     (if (not decode)
106         extraction
107         ; cadr: fetches expression to be evaluated
108         ; caar: fetches symbol in arglist
109         ; cadar: fetches `pc' symbol in arglist
110         (rtl-c DFLT
111                (obj-isa-list f)
112                (list (list (caar decode) 'UINT extraction)
113                      (list (cadar decode) 'IAI "pc"))
114                (cadr decode)
115                #:rtl-cover-fns? #f #:ifield-var? #t)))
116 )
117
118 ; Subroutine of /gen-ifld-extract-beyond to extract the relevant value
119 ; from WORD-NAME and move it into place.
120
121 (define (/gen-extract-word word-name word-start word-length
122                            field-start field-length
123                            unsigned? lsb0?)
124   (let* ((word-end (+ word-start word-length))
125          (start (if lsb0? (+ 1 (- field-start field-length)) field-start))
126          (end (+ start field-length))
127          (base (if (< start word-start) word-start start)))
128     (string-append "("
129                    "EXTRACT_"
130                    (if lsb0? "LSB0" "MSB0")
131                    (if (and (not unsigned?)
132                             ; Only want sign extension for word with sign bit.
133                             (bitrange-overlap? field-start 1
134                                                word-start word-length
135                                                lsb0?))
136                        "_INT ("
137                        "_UINT (")
138                    ; What to extract from.
139                    word-name
140                    ", "
141                    ; Size of this chunk.
142                    (number->string word-length)
143                    ", "
144                    ; MSB of this chunk.
145                    (number->string
146                     (if lsb0?
147                         (if (> end word-end)
148                             (- word-end 1)
149                             (- end word-start 1))
150                         (if (< start word-start)
151                             0
152                             (- start word-start))))
153                    ", "
154                    ; Length of field within this chunk.
155                    (number->string (if (< end word-end)
156                                        (- end base)
157                                        (- word-end base)))
158                    ") << "
159                    ; Adjustment for this chunk within a full field.
160                    (number->string (if (> end word-end)
161                                        (- end word-end)
162                                        0))
163                    ")"))
164 )
165
166 ; Return C code to extract a field that extends beyond the base insn.
167 ;
168 ; Things get tricky in the non-integral-insn case (no kidding).
169 ; This case includes every architecture with at least one insn larger
170 ; than 32 bits, and all architectures where insns smaller than 32 bits
171 ; can't be interpreted as an int.
172 ; ??? And maybe other architectures not considered yet.
173 ; We want to handle these reasonably fast as this includes architectures like
174 ; the ARC and I960 where 99% of the insns are 32 bits, with a few insns that
175 ; take a 32 bit immediate.  It would be a real shame to unnecessarily slow down
176 ; handling of 99% of the instruction set just for a few insns.  Fortunately
177 ; for these chips base-insn includes these insns, so things fall out naturally.
178 ;
179 ; BASE-LENGTH is base-insn-bitsize.
180 ; TOTAL-LENGTH is the total length of the insn.
181 ; VAR-LIST is a list of variables containing the insn.
182 ; Each element in VAR-LIST is (name start length).
183 ; The contents of the insn are in several variables: insn, word_[123...],
184 ; where `insn' contains the "base insn" and `word_N' is a set of variables
185 ; recording the rest of the insn, 32 bits at a time (with the last one
186 ; containing whatever is left over).
187
188 (define (/gen-ifld-extract-beyond f base-length total-length var-list)
189    ; First compute the list of variables that contains pieces of the
190    ; desired value.
191    (let ((start (+ (ifld-start f) (ifld-word-offset f)))
192          (length (ifld-length f))
193          ;(word-start (ifld-word-offset f))
194          ;(word-length (ifld-word-length f))
195          ; extraction code
196          (extraction #f)
197          ; extra processing to perform on extracted value
198          (decode (ifld-decode f))
199          (lsb0? (current-arch-insn-lsb0?)))
200      ; Find which vars are needed and move the value into place.
201      (let loop ((var-list var-list) (result (list ")")))
202        (if (null? var-list)
203            (set! extraction (apply string-append (cons "(0" result)))
204            (let ((var-name (caar var-list))
205                  (var-start (cadar var-list))
206                  (var-length (caddar var-list)))
207              (if (bitrange-overlap? start length
208                                     var-start var-length
209                                     lsb0?)
210                  (loop (cdr var-list)
211                        (cons "|"
212                              (cons (/gen-extract-word var-name
213                                                       var-start
214                                                       var-length
215                                                       start length
216                                                       (eq? (mode:class (ifld-mode f))
217                                                            'UINT)
218                                                       lsb0?)
219                                    result)))
220                  (loop (cdr var-list) result)))))
221      ; If the field doesn't have a special decode expression, just return the
222      ; raw extracted value.  Otherwise, emit the expression.
223      (if (not decode)
224          extraction
225          ; cadr: fetches expression to be evaluated
226          ; caar: fetches symbol in arglist
227          ; cadar: fetches `pc' symbol in arglist
228          (rtl-c DFLT
229                 (obj-isa-list f)
230                 (list (list (caar decode) 'UINT extraction)
231                       (list (cadar decode) 'IAI "pc"))
232                 (cadr decode)
233                 #:rtl-cover-fns? #f #:ifield-var? #t)))
234 )
235
236 ; Return C code to extract <ifield> F.
237
238 (define (gen-ifld-extract f indent base-length total-length base-value var-list macro?)
239   (string-append
240    indent
241    (gen-sym f)
242    " = "
243    (if (adata-integral-insn? CURRENT-ARCH)
244        (/gen-ifld-extract-base f total-length base-value)
245        (if (ifld-beyond-base? f)
246            (/gen-ifld-extract-beyond f base-length total-length var-list)
247            (/gen-ifld-extract-base f base-length base-value)))
248    ";"
249    (if macro? " \\\n" "\n")
250    )
251 )
252
253 ; Return C code to extract a <multi-ifield> from an insn.
254 ; This must have the same signature as gen-ifld-extract as both can be
255 ; made methods in application code.
256
257 (define (gen-multi-ifld-extract f indent base-length total-length base-value var-list macro?)
258   ; The subfields must have already been extracted.
259   (let* ((decode-proc (ifld-decode f))
260          (varname (gen-sym f))
261          (decode (string-list
262                   ;; First, the block that extract the multi-ifield into the ifld variable.
263                   (rtl-c VOID (obj-isa-list f) nil
264                          (multi-ifld-extract f)
265                          #:rtl-cover-fns? #f #:ifield-var? #t)
266                   ;; Next, the decode routine that modifies it.
267                   (if decode-proc
268                       (string-append
269                        "  " varname " = "
270                        (rtl-c DFLT
271                               (obj-isa-list f)
272                               (list (list (caar decode-proc) 'UINT varname)
273                                     (list (cadar decode-proc) 'IAI "pc"))
274                               (cadr decode-proc)
275                               #:rtl-cover-fns? #f #:ifield-var? #t)
276                        ";\n")
277                       "")
278                  )))
279     (if macro?
280         (backslash "\n" decode)
281         decode))
282 )
283
284 ; Return C symbol of variable containing the extracted field value
285 ; in the extraction code.  E.g. f_rd = EXTRACT_UINT (insn, ...).
286
287 (define (gen-extracted-ifld-value f)
288   (gen-sym f)
289 )
290
291 ; Subroutine of gen-extract-ifields to compute arguments for /extract-chunk
292 ; to extract values beyond the base insn.
293 ; This is also used by gen-define-ifields to know how many vars are needed.
294 ;
295 ; The result is a list of (offset . length) pairs.
296 ;
297 ; ??? Here's a case where explicitly defined instruction formats can
298 ; help - without them we can only use heuristics (which must evolve).
299 ; At least all the details are tucked away here.
300
301 (define (/extract-chunk-specs base-length total-length alignment)
302   (let ((chunk-length
303          (case alignment
304            ; For the aligned and forced case split the insn up into base-insn
305            ; sized chunks.  For the unaligned case, use a chunk-length of 32.
306            ; 32 was chosen because the values are extracted into portable ints.
307            ((aligned forced) (min base-length 32))
308            ((unaligned) 32)
309            (else (error "unknown alignment" alignment)))))
310     (let loop ((start base-length)
311                (remaining (- total-length base-length))
312                (result nil))
313       (if (<= remaining 0)
314           (reverse! result)
315           (loop (+ start chunk-length)
316                 (- remaining chunk-length)
317                 ; Always fetch full CHUNK-LENGTH-sized chunks here,
318                 ; even if we don't actually need that many bytes.
319                 ; gen-ifetch only handles "normal" fetch sizes,
320                 ; and /gen-extract-word already knows how to find what
321                 ; it needs if we give it too much.
322                 (cons (cons start chunk-length)
323                       result)))))
324 )
325
326 ; Subroutine of gen-define-ifmt-ifields and gen-extract-ifmt-ifields to
327 ; insert the subfields of any multi-ifields present into IFLDS.
328 ; Subfields are inserted before their corresponding multi-ifield as they
329 ; are initialized in order.
330
331 (define (/extract-insert-subfields iflds)
332   (let loop ((result nil) (iflds iflds))
333     (cond ((null? iflds)
334            (reverse! result))
335           ((multi-ifield? (car iflds))
336            (loop (cons (car iflds)
337                        ; There's no real need to reverse the subfields here
338                        ; other than to keep them in order.
339                        (append (reverse (multi-ifld-subfields (car iflds)))
340                                result))
341                  (cdr iflds)))
342           (else
343            (loop (cons (car iflds) result) (cdr iflds)))))
344 )
345
346 ; Return C code to define local vars to contain IFIELDS.
347 ; All insns using the result have the same TOTAL-LENGTH (in bits).
348 ; INDENT is a string prepended to each line.
349 ; MACRO? is #t if the code is part of a macro (and thus '\\' must be appended
350 ; to each line).
351
352 (define (gen-define-ifields ifields total-length indent macro?)
353   (let* ((base-length (if (adata-integral-insn? CURRENT-ARCH)
354                           32
355                           (state-base-insn-bitsize)))
356          (chunk-specs (/extract-chunk-specs base-length total-length
357                                             (current-arch-default-alignment))))
358     (string-list
359      (string-list-map (lambda (f)
360                         (gen-ifld-extract-decl f indent macro?))
361                       ifields)
362      ; Define enough ints to hold the trailing part of the insn,
363      ; N bits at a time.
364      ; ??? This could be more intelligent of course.  Later.
365      ; ??? Making these global to us would allow filling them during
366      ; decoding.
367      (if (> total-length base-length)
368          (string-list
369           indent
370           "/* Contents of trailing part of insn.  */"
371           (if macro? " \\\n" "\n")
372           (string-list-map (lambda (chunk-num)
373                              (string-list indent
374                                           "UINT word_"
375                                           (number->string chunk-num)
376                                           (if macro? "; \\\n" ";\n")))
377                            (iota (length chunk-specs) 1)))
378          "")))
379 )
380
381 ; Return C code to define local vars to contain IFIELDS of <iformat> IFMT.
382 ; INDENT is a string prepended to each line.
383 ; MACRO? is #t if the code is part of a macro (and thus '\\' must be appended
384 ; to each line).
385 ; USE-MACRO? is #t if instead of generating the fields, we return the macro
386 ; that does that.
387
388 (define (gen-define-ifmt-ifields ifmt indent macro? use-macro?)
389   (let ((macro-name (string-append
390                      "EXTRACT_" (string-upcase (gen-sym ifmt))
391                      "_VARS"))
392         (ifields (/extract-insert-subfields (ifmt-ifields ifmt))))
393     (if use-macro?
394         (string-list indent macro-name
395                      " /*"
396                      (string-list-map (lambda (fld)
397                                         (string-append " " (obj:str-name fld)))
398                                       ifields)
399                      " */\n")
400         (let ((indent (if macro? (string-append indent "  ") indent)))
401           (string-list
402            (if macro?
403                (string-list "#define " macro-name " \\\n")
404                (string-list indent "/* Instruction fields.  */\n"))
405            (gen-define-ifields ifields (ifmt-length ifmt) indent macro?)
406            indent "unsigned int length;"
407            ; The last line doesn't have a trailing '\\'.
408            "\n"
409            ))))
410 )
411
412 ; Subroutine of gen-extract-ifields to fetch one value into VAR-NAME.
413
414 (define (/extract-chunk offset bits var-name macro?)
415   (string-append
416    "  "
417    var-name
418    " = "
419    (gen-ifetch "pc" offset bits)
420    ";"
421    (if macro? " \\\n" "\n"))
422 )
423
424 ; Subroutine of gen-extract-ifields to compute the var-list arg to
425 ; gen-ifld-extract-beyond.
426 ; The result is a list of `(name start length)' elements describing the
427 ; variables holding the parts of the insn.
428 ; CHUNK-SPECS is a list of (offset . length) pairs.
429
430 (define (/gen-extract-beyond-var-list base-length var-prefix chunk-specs lsb0?)
431   ; ??? lsb0? support ok?
432   (cons (list "insn" 0 base-length)
433         (map (lambda (chunk-num chunk-spec)
434                (list (string-append var-prefix (number->string chunk-num))
435                      (car chunk-spec)
436                      (cdr chunk-spec)))
437              (iota (length chunk-specs) 1)
438              chunk-specs))
439 )
440
441 ; Return C code to extract IFIELDS.
442 ; All insns using the result have the same TOTAL-LENGTH (in bits).
443 ; MACRO? is #t if the code is part of a macro (and thus '\\' must be appended
444 ; to each line).
445 ;
446 ; Here is where we handle integral-insn vs non-integeral-insn architectures.
447 ;
448 ; Examples of architectures that can be handled as integral-insns are:
449 ; sparc, m32r, mips, etc.
450 ;
451 ; Examples of architectures that can't be handled as integral insns are:
452 ; arc, i960, fr30, i386, m68k.
453 ; [i386,m68k are only mentioned for completeness.  cgen ports of these
454 ; would be great, but more thought is needed first]
455 ;
456 ; C variable `insn' is assumed to contain the base part of the insn
457 ; (max base-insn-bitsize insn-bitsize).  In the m32r case insn-bitsize
458 ; can be less than base-insn-bitsize.
459 ;
460 ; ??? Need to see how well gcc optimizes this.
461 ;
462 ; ??? Another way to do this is to put this code in an inline function that
463 ; gets passed pointers to each ifield variable.  GCC is smart enough to
464 ; produce optimal code for this, but other compilers may not have inlining
465 ; or the indirection removal.  I think the slowdown for a non-scache simulator
466 ; would be phenomenal and while one can say "too bad, use gcc", I'm defering
467 ; doing this for now.
468
469 (define (gen-extract-ifields ifields total-length indent macro?)
470   (let* ((base-length (if (adata-integral-insn? CURRENT-ARCH)
471                           32
472                           (state-base-insn-bitsize)))
473          (chunk-specs (/extract-chunk-specs base-length total-length
474                                             (current-arch-default-alignment))))
475     (string-list
476      ; If the insn has a trailing part, fetch it.
477      ; ??? Could have more intelligence here.  Later.
478      (if (> total-length base-length)
479          (let ()
480            (string-list-map (lambda (chunk-spec chunk-num)
481                               (/extract-chunk (car chunk-spec)
482                                               (cdr chunk-spec)
483                                               (string-append
484                                                "word_"
485                                                (number->string chunk-num))
486                                               macro?))
487                             chunk-specs
488                             (iota (length chunk-specs) 1)))
489          "")
490      (string-list-map
491       (lambda (f)
492         ; Dispatching on a method works better, as would a generic fn.
493         ; ??? Written this way to pass through Hobbit, doesn't handle
494         ; ((if foo a b) (arg1 arg2)).
495         (if (multi-ifield? f)
496             (gen-multi-ifld-extract
497              f indent base-length total-length "insn"
498              (/gen-extract-beyond-var-list base-length "word_"
499                                            chunk-specs
500                                            (current-arch-insn-lsb0?))
501              macro?)
502             (gen-ifld-extract
503              f indent base-length total-length "insn"
504              (/gen-extract-beyond-var-list base-length "word_"
505                                            chunk-specs
506                                            (current-arch-insn-lsb0?))
507              macro?)))
508       ifields)
509      ))
510 )
511
512 ; Return C code to extract the fields of <iformat> IFMT.
513 ; MACRO? is #t if the code is part of a macro (and thus '\\' must be appended
514 ; to each line).
515 ; USE-MACRO? is #t if instead of generating the fields, we return the macro
516 ; that does that.
517
518 (define (gen-extract-ifmt-ifields ifmt indent macro? use-macro?)
519   (let ((macro-name (string-append
520                      "EXTRACT_" (string-upcase (gen-sym ifmt))
521                      "_CODE"))
522         (ifields (/extract-insert-subfields (ifmt-ifields ifmt))))
523     (if use-macro?
524         (string-list indent macro-name "\n")
525         (let ((indent (if macro? (string-append indent "  ") indent)))
526           (string-list
527            (if macro?
528                (string-list "#define " macro-name " \\\n")
529                "")
530            indent "length = "
531            (number->string (bits->bytes (ifmt-length ifmt)))
532            ";"
533            (if macro? " \\\n" "\n")
534            (gen-extract-ifields ifields (ifmt-length ifmt) indent macro?)
535            ; The last line doesn't have a trailing '\\'.
536            "\n"
537            ))))
538 )
539 \f
540 ; Instruction format utilities.
541
542 (define (gen-sfmt-enum-decl sfmt-list)
543   (gen-enum-decl "@prefix@_sfmt_type"
544                  "semantic formats in cpu family @cpu@"
545                  "@PREFIX@_"
546                  (map (lambda (sfmt) (cons (obj:name sfmt) nil))
547                       sfmt-list))
548 )