cgen/html.scm

   1 ; CPU documentation generator, html output
   2 ; Copyright (C) 2003, 2009 Doug Evans
   3 ; This file is part of CGEN.  See file COPYING.CGEN for details.
   4 ;
   5 ; TODO:
   6 ; - assumes names, comments, etc. don't interfere with html.
   7 ;   Just like in generation of C there are routines to C-ize symbols,
   8 ;   we need to pass output through an html-izer.
   9 ; - make generated html more readable, e.g. more indentation
  10 ; - should really print the semantics in pseudo-C, a much better form for
  11 ;   the intended audience
  12 ; - registers that have multiple independent fields (like x86 eflags)
  13 ;   need to be printed like instruction formats are
  14 ; - uses some deprecated html, use css at very least
  15 ; - multi-ifields ok?
  16 ; - mapping from operands to h/w isn't as clear as it needs to be
  17 ; - for insn formats, if field is large consider printing "n ... m",
  18 ;   would want "n" left justified and "m" right justified though
  19 ; - for insn formats, consider printing them better,
  20 ;   e.g. maybe generate image and include that instead
  21 ; - need ability to specify more prose for each architecture
  22 ; - assembler support
  23 ; - need to add docs to website that can be linked to here, rather than
  24 ;   including generic cgen documentation here
  25 ; - function units, timing, etc.
  26 ; - instruction framing
  27
  28 ; Global state variables.
  29
  30 ; Specify which application.
  31 (set! APPLICATION 'DOC)
  32
  33 ; String containing copyright text.
  34 (define CURRENT-COPYRIGHT #f)
  35
  36 ; String containing text defining the package we're generating code for.
  37 (define CURRENT-PACKAGE #f)
  38
  39 (define copyright-doc
  40   (cons "\
  41 THIS FILE IS MACHINE GENERATED WITH CGEN.
  42
  43 See the input .cpu file(s) for copyright information.
  44 "
  45         "\
  46 "))
  47
  48 ; Initialize the options.
  49
  50 (define (option-init!)
  51   (set! CURRENT-COPYRIGHT copyright-doc)
  52   (set! CURRENT-PACKAGE package-cgen)
  53   *UNSPECIFIED*
  54 )
  55
  56 ; Handle an option passed in from the command line.
  57
  58 (define (option-set! name value)
  59   (case name
  60     ((copyright) (cond ((equal?  value '("doc"))
  61                         (set! CURRENT-COPYRIGHT copyright-doc))
  62                        (else (error "invalid copyright value" value))))
  63     ((package) (cond ((equal?  value '("cgen"))
  64                       (set! CURRENT-PACKAGE package-cgen))
  65                      (else (error "invalid package value" value))))
  66     (else (error "unknown option" name))
  67     )
  68   *UNSPECIFIED*
  69 )
  70 \f
  71 ; Misc utilities.
  72
  73 ; Return COPYRIGHT, with FILE-DESC as the first line
  74 ; and PACKAGE as the name of the package which the file belongs in.
  75 ; COPYRIGHT is a pair of (header . trailer).
  76
  77 (define (gen-html-copyright file-desc copyright package)
  78   (string-append "<! " file-desc "\n\n"
  79                  (car copyright)
  80                  "\n" package "\n"
  81                  (cdr copyright)
  82                  "\n>\n\n")
  83 )
  84
  85 ; KIND is one of "Architecture" or "Instruction".
  86 ; TODO: Add author arg so all replies for this arch go to right person.
  87
  88 (define (gen-html-header kind)
  89   (let* ((arch (symbol->string (current-arch-name)))
  90          (ARCH (string-upcase arch)))
  91     (string-list
  92      "<!doctype html public \"-//w3c//dtd html 4.0 transitional//en\">\n"
  93      "<html>\n"
  94      "<head>\n"
  95      "  <meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-1\">\n"
  96      "  <meta name=\"description\" content=\"" ARCH " " kind " Documentation\">\n"
  97      "  <meta name=\"language\" content=\"en-us\">\n"
  98      "  <meta name=\"owner\" content=\"dje@sebabeach.org (Doug Evans)\">\n"
  99      "  <meta name=\"reply-to\" content=\"dje@sebabeach.org (Doug Evans)\">\n"
 100      "  <title>" ARCH " " kind " Documentation</title>\n"
 101      "</head>\n"
 102      "<body bgcolor=\"#F0F0F0\" TEXT=\"#003333\" LINK=\"#FF0000\" VLINK=\"#444444\" alink=\"#000000\">\n"
 103      )
 104     )
 105 )
 106
 107 (define (gen-html-trailer)
 108   (string-list
 109    "\n"
 110    "<p><hr><p>\n"
 111    "This documentation was machine generated from the cgen cpu description\n"
 112    "files for this architecture.\n"
 113    "<br>\n"
 114    "<a href=\"http://sources.redhat.com/cgen/\">http://sources.redhat.com/cgen/</a>\n"
 115    "</body>\n"
 116    "</html>\n"
 117    )
 118 )
 119
 120 ; INSN-FILE is the name of the .html file containing instruction definitions.
 121
 122 (define (gen-table-of-contents insn-file)
 123   (let ((ARCH (string-upcase (symbol->string (current-arch-name)))))
 124     (string-list
 125      "<h1>\n"
 126      (string-append ARCH " Architecture Documentation")
 127      "</h1>\n"
 128      "\n"
 129      "<br>\n"
 130      "DISCLAIMER: This documentation is derived from the cgen cpu description\n"
 131      "of this architecture, and does not represent official documentation\n"
 132      "of the chip maker.\n"
 133      "<p><hr><p>\n"
 134      "\n"
 135      "<ul>\n"
 136      "<li><a href=\"#arch\">Architecture</a></li>\n"
 137      "<li><a href=\"#machines\">Machine variants</a></li>\n"
 138      "<li><a href=\"#models\">Model variants</a></li>\n"
 139      "<li><a href=\"#registers\">Registers</a></li>\n"
 140      "<li><a href=\"" insn-file "#insns\">Instructions</a></li>\n"
 141      "<li><a href=\"" insn-file "#macro-insns\">Macro instructions</a></li>\n"
 142      "<li><a href=\"#assembler\">Assembler supplemental</a></li>\n"
 143      "</ul>\n"
 144      "<br>\n"
 145      ; TODO: Move this to the cgen website, and include a link here.
 146      "In cgen-parlance, an architecture consists of machines and models.\n"
 147      "A `machine' is the specification of a variant of the architecture,\n"
 148      "and a `model' is the implementation of that specification.\n"
 149      "Typically there is a one-to-one correspondance between machine and model.\n"
 150      "The distinction allows for separation of what application programs see\n"
 151      "(the machine), and how to tune for the chip (what the compiler sees).\n"
 152      "<br>\n"
 153      "A \"cpu family\" is a cgen concoction to help organize the generated code.\n"
 154      "Chip variants that are quite dissimilar can be treated separately by the\n"
 155      "generated code even though they're both members of the same architecture.\n"
 156       ))
 157 )
 158
 159 ; Utility to print a list entry for NAME/COMMENT, kind KIND
 160 ; which is a link to the entry's description.
 161 ; KIND is one of "mach", "model", etc.
 162
 163 (define (gen-list-entry name comment kind)
 164   (string-append "<li>"
 165                  "<a href=\"#" kind "-" (->string name) "\">"
 166                  (->string name)
 167                  " - "
 168                  comment
 169                  "</a>\n"
 170                  "</li>\n")
 171 )
 172
 173 ; Cover-fn to gen-list-entry for use with objects.
 174
 175 (define (gen-obj-list-entry o kind)
 176   (gen-list-entry (obj:name o) (obj:comment o) kind)
 177 )
 178
 179 ; Utility to print the header for the description of TEXT.
 180
 181 (define (gen-doc-header text anchor-name)
 182   (string-list
 183    "<a name=\"" anchor-name "\"></a>\n"
 184    "<h3>" text "</h3>\n"
 185    )
 186 )
 187
 188 ; Cover-fn to gen-doc-header for use with objects.
 189 ; KIND is one of "mach", "model", etc.
 190
 191 (define (gen-obj-doc-header o kind)
 192   (gen-doc-header (string-append (obj:str-name o) " - " (obj:comment o))
 193                   (string-append kind "-" (obj:str-name o)))
 194 )
 195 \f
 196 ; Architecture page.
 197
 198 (define (gen-cpu-intro cpu)
 199   (string-list
 200    "<li>\n"
 201    (obj:str-name cpu) " - " (obj:comment cpu) "\n"
 202    "<br>\n"
 203    "<br>\n"
 204    "Machines:\n"
 205    "<ul>\n"
 206    (string-list-map gen-mach-intro
 207                     (alpha-sort-obj-list (machs-for-cpu cpu)))
 208    "</ul>\n"
 209    "</li>\n"
 210    "<br>\n"
 211    )
 212 )
 213
 214 (define (gen-mach-intro mach)
 215   (string-list
 216    "<li>\n"
 217    (obj:str-name mach) " - " (obj:comment mach) "\n"
 218    "<br>\n"
 219    "<br>\n"
 220    "Models:\n"
 221    "<ul>\n"
 222    (string-list-map gen-model-intro
 223                     (alpha-sort-obj-list (models-for-mach mach)))
 224    "</ul>\n"
 225    "</li>\n"
 226    "<br>\n"
 227    )
 228 )
 229
 230 (define (gen-model-intro model)
 231   (string-list
 232    "<li>\n"
 233    (obj:str-name model) " - " (obj:comment model) "\n"
 234    "<br>\n"
 235    "</li>\n"
 236    )
 237 )
 238
 239 (define (gen-isa-intro isa)
 240   (string-list
 241    "<li>\n"
 242    (obj:str-name isa) " - " (obj:comment isa) "\n"
 243    "<br>\n"
 244    ; FIXME: wip
 245    ; I'd like to include the .cpu file tag here, but using English text
 246    ; feels more appropriate.  Having both is excessive.
 247    ; Pick one, and have a link to its description/tag.
 248    ; I'm leaning toward using the cgen tag here as we'll probably want
 249    ; access (via an html tag) to more than one-liner descriptions.
 250    "<ul>\n"
 251    "<li>default-insn-word-bitsize: "
 252    (number->string (isa-default-insn-word-bitsize isa))
 253    "</li>\n"
 254    "<br>\n"
 255    "<li>default-insn-bitsize: "
 256    (number->string (isa-default-insn-bitsize isa))
 257    "</li>\n"
 258    "<br>\n"
 259    "<li>base-insn-bitsize: "
 260    (number->string (isa-base-insn-bitsize isa))
 261    "</li>\n"
 262    "<br>\n"
 263    "<li>decode-assist: "
 264    (string-map (lambda (n) (string-append " " (number->string n)))
 265                (isa-decode-assist isa))
 266    "</li>\n"
 267    "<br>\n"
 268    "<li>decode-splits: "
 269    (string-map (lambda (n) (string-append " " (number->string n)))
 270                (isa-decode-splits isa))
 271    "</li>\n"
 272    "<br>\n"
 273    (if (> (isa-liw-insns isa) 1)
 274        (string-append "<li>liw-insns: "
 275                       (number->string (isa-liw-insns isa))
 276                       "</li>\n"
 277                       "<br>\n")
 278        "")
 279    (if (> (isa-parallel-insns isa) 1)
 280        (string-append "<li>parallel-insns: "
 281                       (number->string (isa-parallel-insns isa))
 282                       "</li>\n"
 283                       "<br>\n")
 284        "")
 285    (if (isa-condition isa)
 286        (string-append "<li>condition-field: "
 287                       (symbol->string (car (isa-condition isa)))
 288                       "</li>\n"
 289                       "<br>\n"
 290                       "<li>condition:\n"
 291                       "<font size=+2>\n"
 292                       "<pre>" ; no trailing newline here on purpose
 293                       (with-output-to-string
 294                         (lambda ()
 295                           (pretty-print (cadr (isa-condition isa)))))
 296                       "</pre></font>\n"
 297                       "</li>\n"
 298                       "<br>\n")
 299        "")
 300    (if (isa-setup-semantics isa)
 301        (string-append "<li>setup-semantics:\n"
 302                       "<font size=+2>\n"
 303                       "<pre>" ; no trailing newline here on purpose
 304                       (with-output-to-string
 305                         (lambda ()
 306                           (pretty-print (cdr (isa-setup-semantics isa)))))
 307                       "</pre></font>\n"
 308                       "</li>\n"
 309                       "<br>\n")
 310        "")
 311    "</ul>\n"
 312    "</li>\n"
 313    )
 314 )
 315
 316 (define (gen-arch-intro)
 317   ; NOTE: This includes cpu families.
 318   (let ((ARCH (string-upcase (symbol->string (current-arch-name))))
 319         (isas (current-isa-list))
 320         (cpus (current-cpu-list))
 321         )
 322     (string-list
 323      "\n"
 324      "<hr>\n"
 325      "<a name=\"arch\"></a>\n"
 326      "<h2>" ARCH " Architecture</h2>\n"
 327      "<p>\n"
 328      "This section describes various things about the cgen description of\n"
 329      "the " ARCH " architecture.  Familiarity with cgen cpu descriptions\n"
 330      "is assumed.\n"
 331      "<p>\n"
 332      "Bit number orientation (arch.lsb0?): "
 333      (if (current-arch-insn-lsb0?) "lsb = 0" "msb = 0")
 334      "\n"
 335      "<p>\n"
 336      "<h3>ISA description</h3>\n"
 337      ; NOTE: For the normal case there's only one isa, thus specifying it in
 338      ; a list is excessive.  Later.
 339      "<p>\n"
 340      "<ul>\n"
 341      (string-list-map gen-isa-intro
 342                       (alpha-sort-obj-list isas))
 343      "</ul>\n"
 344      "<p>\n"
 345      "<h3>CPU Families</h3>\n"
 346      "<ul>\n"
 347      (string-list-map gen-cpu-intro
 348                       (alpha-sort-obj-list cpus))
 349      "</ul>\n"
 350      ))
 351 )
 352 \f
 353 ; Machine page.
 354
 355 (define (gen-machine-doc-1 mach)
 356   (string-list
 357    (gen-obj-doc-header mach "mach")
 358    "<ul>\n"
 359    "<li>\n"
 360    "bfd-name: "
 361    (mach-bfd-name mach)
 362    "\n"
 363    "</li>\n"
 364    "<li>\n"
 365    "isas: "
 366    (string-map (lambda (isa)
 367                  (string-append " " (obj:str-name isa)))
 368                (mach-isas mach))
 369    "\n"
 370    "</li>\n"
 371    "</ul>\n"
 372    )
 373 )
 374
 375 (define (gen-machine-docs)
 376   (let ((machs (alpha-sort-obj-list (current-mach-list))))
 377     (string-list
 378      "\n"
 379      "<hr>\n"
 380      "<a name=\"machines\"></a>\n"
 381      "<h2>Machine variants</h2>\n"
 382      "<ul>\n"
 383      (string-map (lambda (o)
 384                    (gen-obj-list-entry o "mach"))
 385                  machs)
 386      "</ul>\n"
 387      (string-list-map gen-machine-doc-1 machs)
 388      ))
 389 )
 390 \f
 391 ; Model page.
 392
 393 (define (gen-model-doc-1 model)
 394   (string-list
 395    (gen-obj-doc-header model "model")
 396    "<ul>\n"
 397    "</ul>\n"
 398    )
 399 )
 400
 401 (define (gen-model-docs)
 402   (let ((models (alpha-sort-obj-list (current-model-list))))
 403     (string-list
 404      "\n"
 405      "<hr>\n"
 406      "<a name=\"models\"></a>\n"
 407      "<h2>Model variants</h2>\n"
 408      "<ul>\n"
 409      (string-map (lambda (o)
 410                    (gen-obj-list-entry o "model"))
 411                  models)
 412      "</ul>\n"
 413      (string-list-map gen-model-doc-1 models)
 414      ))
 415 )
 416 \f
 417 ; Register page.
 418 ;
 419 ; TODO: Provide tables of regs for each mach.
 420
 421 ; Subroutine of gen-reg-doc-1 to simplify it.
 422 ; Generate a list of names of registers in register array REG.
 423 ; The catch is that we want to shrink r0,r1,r2,...,r15 to r0...r15.
 424
 425 (define (gen-pretty-reg-array-names reg)
 426   ; We currently only support arrays of rank 1 (vectors).
 427   (if (!= (hw-rank reg) 1)
 428       (error "gen-pretty-reg-array-names: unsupported rank" (hw-rank reg)))
 429   (let ((indices (hw-indices reg)))
 430     (if (class-instance? <keyword> indices)
 431         (let ((values (kw-values indices)))
 432           (string-list
 433            "<br>\n"
 434            "names:\n"
 435            "<br>\n"
 436            "<table frame=border border=2>\n"
 437            "<tr>\n"
 438            (string-list-map (lambda (v)
 439                               (string-list "<tr>\n"
 440                                            "<td>"
 441                                            (car v)
 442                                            "</td>\n"
 443                                            "<td>"
 444                                            (number->string (cadr v))
 445                                            "</td>\n"
 446                                            "</tr>\n"))
 447                             values)))
 448         ""))
 449 )
 450
 451 (define (gen-reg-doc-1 reg)
 452   (string-list
 453    (gen-obj-doc-header reg "reg")
 454    "<ul>\n"
 455    "<li>\n"
 456    "machines: "
 457    (string-map (lambda (mach)
 458                  (string-append " " (symbol->string mach)))
 459                (obj-attr-value reg 'MACH))
 460    "\n"
 461    "</li>\n"
 462    "<li>\n"
 463    "bitsize: "
 464    (number->string (hw-bits reg))
 465    "\n"
 466    "</li>\n"
 467    (if (not (hw-scalar? reg))
 468        (string-list "<li>\n"
 469                     "array: "
 470                     (string-map (lambda (dim)
 471                                   (string-append "[" (number->string dim) "]"))
 472                                 (hw-shape reg))
 473                     "\n"
 474                     (gen-pretty-reg-array-names reg)
 475                     "</li>\n")
 476        "")
 477    "</ul>\n"
 478    )
 479 )
 480
 481 (define (gen-register-docs)
 482   (let ((regs (alpha-sort-obj-list (find register? (current-hw-list)))))
 483     (string-list
 484      "\n"
 485      "<hr>\n"
 486      "<a name=\"registers\"></a>\n"
 487      "<h2>Registers</h2>\n"
 488      "<ul>\n"
 489      (string-map (lambda (o)
 490                    (gen-obj-list-entry o "reg"))
 491                  regs)
 492      "</ul>\n"
 493      (string-list-map gen-reg-doc-1 regs)
 494      ))
 495 )
 496 \f
 497 ; Instruction page.
 498
 499 ; Generate a diagram typically used to display instruction fields.
 500 ; OPERANDS is a list of numbers (for constant valued ifields)
 501 ; or operand names.
 502
 503 (define (gen-iformat-table-1 bitnums names operands)
 504   (string-list
 505    "<table frame=border border=2>\n"
 506    "<tr>\n"
 507    (string-list-map (lambda (b)
 508                       (string-list "<td>\n"
 509                                    (string-map (lambda (n)
 510                                                  (string-append " "
 511                                                                 (number->string n)))
 512                                                b)
 513                                    "\n"
 514                                    "</td>\n"))
 515                     bitnums)
 516    "</tr>\n"
 517    "<tr>\n"
 518    (string-list-map (lambda (n)
 519                       (string-list "<td>\n"
 520                                    n
 521                                    "\n"
 522                                    "</td>\n"))
 523                     names)
 524    "</tr>\n"
 525    "<tr>\n"
 526    (string-list-map (lambda (o)
 527                       (string-list "<td>\n"
 528                                    (if (number? o)
 529                                        (string-append "0x"
 530                                                       (number->string o 16))
 531                                        o)
 532                                    "\n"
 533                                    "</td>\n"))
 534                     operands)
 535    "</tr>\n"
 536    "</table>\n")
 537 )
 538
 539 ; Compute the list of field bit-numbers for each field.
 540
 541 (define (get-ifield-bitnums widths lsb0?)
 542   (let* ((total-width (apply + widths))
 543          (bitnums (iota total-width
 544                         (if lsb0? (1- total-width) 0)
 545                         (if lsb0? -1 1))))
 546     (let loop ((result '()) (widths widths) (bitnums bitnums))
 547       (if (null? widths)
 548           (reverse! result)
 549           (loop (cons (list-take (car widths) bitnums)
 550                       result)
 551                 (cdr widths)
 552                 (list-drop (car widths) bitnums)))))
 553 )
 554
 555 ; Generate a diagram typically used to display instruction fields.
 556
 557 (define (gen-iformat-table insn)
 558   (let* ((lsb0? (current-arch-insn-lsb0?))
 559          (sorted-iflds (sort-ifield-list (insn-iflds insn) (not lsb0?))))
 560     (let ((widths (map ifld-length sorted-iflds))
 561           (names (map obj:name sorted-iflds))
 562           (operands (map (lambda (f)
 563                            (if (ifld-constant? f)
 564                                (ifld-get-value f)
 565                                (obj:name (ifld-get-value f))))
 566                          sorted-iflds)))
 567       (gen-iformat-table-1 (get-ifield-bitnums widths lsb0?) names operands)))
 568 )
 569
 570 (define (gen-insn-doc-1 insn)
 571   (string-list
 572    (gen-obj-doc-header insn "insn")
 573    "<ul>\n"
 574    "<li>\n"
 575    "machines: "
 576    (string-map (lambda (mach)
 577                  (string-append " " (symbol->string mach)))
 578                (obj-attr-value insn 'MACH))
 579    "\n"
 580    "</li>\n"
 581    "<br>\n"
 582    "<li>\n"
 583    "syntax: "
 584    "<tt><font size=+2>"
 585    (insn-syntax insn)
 586    "</font></tt>\n"
 587    "</li>\n"
 588    "<br>\n"
 589    "<li>\n"
 590    "format:\n"
 591    (gen-iformat-table insn)
 592    "</li>\n"
 593    "<br>\n"
 594    (if (insn-ifield-assertion insn)
 595        (string-append "<li>\n"
 596                       "instruction field constraint:\n"
 597                       "<font size=+2>\n"
 598                       "<pre>" ; no trailing newline here on purpose
 599                       (with-output-to-string
 600                         (lambda ()
 601                           (pretty-print (insn-ifield-assertion insn))))
 602                       "</pre></font>\n"
 603                       "</li>\n"
 604                       "<br>\n")
 605        "")
 606    "<li>\n"
 607    "semantics:\n"
 608    "<font size=+2>\n"
 609    "<pre>" ; no trailing newline here on purpose
 610    (with-output-to-string
 611      (lambda ()
 612        ; Print the const-folded semantics, computed in `tmp'.
 613        (pretty-print (rtx-trim-for-doc (insn-tmp insn)))))
 614    "</pre></font>\n"
 615    "</li>\n"
 616    ; "<br>\n" ; not present on purpose
 617    (if (not (null? (insn-timing insn)))
 618        (string-list "<li>\n"
 619                     "execution unit(s):\n"
 620                     "<br>\n"
 621                     "<br>\n"
 622                     "<ul>\n"
 623                     (string-list-map
 624                      (lambda (t)
 625                        (string-append "<li>\n"
 626                                       (->string (car t))
 627                                       ": "
 628                                       (string-map (lambda (u)
 629                                                     (string-append " "
 630                                                                    (obj:str-name (iunit:unit u))))
 631                                                   (timing:units (cdr t)))
 632                                       "\n"
 633                                       "</li>\n"))
 634                      ; ignore timings for discarded
 635                      (find (lambda (t) (not (null? (cdr t))))
 636                            (insn-timing insn)))
 637                     "</ul>\n"
 638                     "</li>\n"
 639                     "<br>\n")
 640        "")
 641    "</ul>\n"
 642    )
 643 )
 644
 645 (define (gen-insn-doc-list mach name comment insns)
 646   (string-list
 647    "<hr>\n"
 648    (gen-doc-header (string-append (obj:str-name mach)
 649                                   " "
 650                                   (->string name)
 651                                   (if (string=? comment "")
 652                                       ""
 653                                       (string-append " - " comment)))
 654                    (string-append "mach-insns-"
 655                                   (obj:str-name mach)
 656                                   "-"
 657                                   (->string name)))
 658    "<ul>\n"
 659    (string-list-map (lambda (o)
 660                       (gen-obj-list-entry o "insn"))
 661                     insns)
 662    "</ul>\n"
 663    )
 664 )
 665
 666 ; Return boolean indicating if INSN sets the pc.
 667
 668 (define (insn-sets-pc? insn)
 669   (or (obj-has-attr? insn 'COND-CTI)
 670       (obj-has-attr? insn 'UNCOND-CTI)
 671       (obj-has-attr? insn 'SKIP-CTI))
 672 )
 673
 674 ; Traverse the semantics of INSN and return a list of symbols
 675 ; indicating various interesting properties we find.
 676 ; This is taken from `semantic-attrs' which does the same thing to find the
 677 ; CTI attributes.
 678 ; The result is list of properties computed from the semantics.
 679 ; The possibilities are: MEM, FPU.
 680
 681 (define (get-insn-properties insn)
 682   (logit 2 "Collecting properties of insn " (obj:name insn) " ...\n")
 683
 684   (let*
 685       ((context #f) ; ??? do we need a better context?
 686
 687        ; List of attributes computed from SEM-CODE-LIST.
 688        ; The first element is just a dummy so that append! always works.
 689        (sem-attrs (list #f))
 690
 691        ; Called for expressions encountered in SEM-CODE-LIST.
 692        (process-expr!
 693         (lambda (rtx-obj expr parent-expr op-pos tstate appstuff)
 694           (case (car expr)
 695
 696             ((operand) (if (memory? (op:type (current-op-lookup (rtx-arg1 expr)
 697                                                                 (obj-isa-list insn))))
 698                            ; Don't change to '(MEM), since we use append!.
 699                            (append! sem-attrs (list 'MEM)))
 700                        (if (mode-float? (mode:lookup (rtx-mode expr)))
 701                            ; Don't change to '(FPU), since we use append!.
 702                            (append! sem-attrs (list 'FPU)))
 703                        )
 704
 705             ((mem) (append! sem-attrs (list 'MEM)))
 706
 707             ; If this is a syntax expression, the operands won't have been
 708             ; processed, so tell our caller we want it to by returning #f.
 709             ; We do the same for non-syntax expressions to keep things
 710             ; simple.  This requires collaboration with the traversal
 711             ; handlers which are defined to do what we want if we return #f.
 712             (else #f))))
 713        )
 714
 715     ; Traverse the expression recording the attributes.
 716     ; We just want the side-effects of computing various properties
 717     ; so we discard the result.
 718
 719     (rtx-traverse context
 720                   insn
 721                   ; Simplified semantics recorded in the `tmp' field.
 722                   (insn-tmp insn)
 723                   process-expr!
 724                   #f)
 725
 726     ; Drop dummy first arg and remove duplicates.
 727     (nub (cdr sem-attrs) identity))
 728 )
 729
 730 ; Return boolean indicating if PROPS indicates INSN references memory.
 731
 732 (define (insn-refs-mem? insn props)
 733   (->bool (memq 'MEM props))
 734 )
 735
 736 ; Return boolean indicating if PROPS indicates INSN uses the fpu.
 737
 738 (define (insn-uses-fpu? insn props)
 739   (->bool (memq 'FPU props))
 740 )
 741
 742 ; Ensure INSN has attribute IDOC.
 743 ; If not specified, guess(?).
 744
 745 (define (guess-insn-idoc-attr! insn)
 746   (if (not (obj-attr-present? insn 'IDOC))
 747     (let ((attr #f)
 748           (props (get-insn-properties insn)))
 749       ; Try various heuristics.
 750       (if (and (not attr)
 751                (insn-sets-pc? insn))
 752           (set! attr 'BR))
 753       (if (and (not attr)
 754                (insn-refs-mem? insn props))
 755           (set! attr 'MEM))
 756       (if (and (not attr)
 757                (insn-uses-fpu? insn props))
 758           (set! attr 'FPU))
 759       ; If nothing else works, assume ALU.
 760       (if (not attr)
 761           (set! attr 'ALU))
 762       (obj-cons-attr! insn (enum-attr-make 'IDOC attr))))
 763   *UNSPECIFIED*
 764 )
 765
 766 ; Return subset of insns in IDOC category CAT-NAME.
 767
 768 (define (get-insns-for-category insns cat-name)
 769   (find (lambda (insn)
 770           (obj-has-attr-value-no-default? insn 'IDOC cat-name))
 771         insns)
 772 )
 773
 774 ; CATEGORIES is a list of "enum value" elements for each category.
 775 ; See <enum-attribute> for the definition.
 776 ; INSNS is already alphabetically sorted and selected for just MACH.
 777
 778 (define (gen-categories-insn-lists mach categories insns)
 779   (string-list
 780    ; generate a table of insns for each category
 781    (string-list-map (lambda (c)
 782                       (let ((cat-insns (get-insns-for-category insns (enum-val-name c)))
 783                             (comment (enum-val-comment c)))
 784                         (if (null? cat-insns)
 785                             ""
 786                             (gen-insn-doc-list mach (enum-val-name c) comment cat-insns))))
 787                     categories)
 788    ; lastly, the alphabetical list
 789    (gen-insn-doc-list mach (obj:name mach) (obj:comment mach) insns)
 790    )
 791 )
 792
 793 ; CATEGORIES is a list of "enum value" elements for each category.
 794 ; See <enum-attribute> for the definition.
 795 ; INSNS is already alphabetically sorted and selected for just MACH.
 796
 797 (define (gen-insn-categories mach categories insns)
 798   (string-list
 799    "<ul>\n"
 800    (string-list-map (lambda (c)
 801                       (let ((cat-insns (get-insns-for-category insns (enum-val-name c)))
 802                             (comment (enum-val-comment c)))
 803                         (if (null? cat-insns)
 804                             ""
 805                             (string-list
 806                              "<li><a href=\"#mach-insns-"
 807                              (obj:str-name mach)
 808                              "-"
 809                              (->string (enum-val-name c))
 810                              "\">"
 811                              (->string (enum-val-name c))
 812                              (if (string=? comment "")
 813                                  ""
 814                                  (string-append " - " comment))
 815                              "</a></li>\n"
 816                              ))))
 817                     categories)
 818    "<li><a href=\"#mach-insns-"
 819    (obj:str-name mach)
 820    "-"
 821    (obj:str-name mach)
 822    "\">alphabetically</a></li>\n"
 823    "</ul>\n"
 824    )
 825 )
 826
 827 ; ??? There's an inefficiency here, we compute insns for each mach for each
 828 ; category twice.  Left for later if warranted.
 829
 830 (define (gen-insn-docs)
 831   ; First simplify the semantics, e.g. do constant folding.
 832   ; For insns built up from macros, often this will remove a lot of clutter.
 833   (for-each (lambda (insn)
 834               (logit 2 "Simplifying the rtl for insn " (obj:name insn) " ...\n")
 835               (insn-set-tmp! insn (rtx-simplify-insn #f insn)))
 836             (current-insn-list))
 837
 838   (let ((machs (current-mach-list))
 839         (insns (alpha-sort-obj-list (current-insn-list)))
 840         (categories (attr-values (current-attr-lookup 'IDOC))))
 841     ; First, install IDOC attributes for insns that don't specify one.
 842     (for-each guess-insn-idoc-attr! insns)
 843     (string-list
 844      "\n"
 845      "<hr>\n"
 846      "<a name=\"insns\"></a>\n"
 847      "<h2>Instructions</h2>\n"
 848      "Instructions for each machine:\n"
 849      "<ul>\n"
 850 ;     (string-map (lambda (o)
 851 ;                  (gen-obj-list-entry o "mach-insns"))
 852 ;                machs)
 853      (string-list-map (lambda (m)
 854                         (let ((mach-insns (find (lambda (insn)
 855                                                   (mach-supports? m insn))
 856                                                 insns)))
 857                           (string-list "<li>"
 858                                        (obj:str-name m)
 859                                        " - "
 860                                        (obj:comment m)
 861                                        "</li>\n"
 862                                        (gen-insn-categories m categories mach-insns)
 863                            )))
 864                       machs)
 865      "</ul>\n"
 866 ;     (string-list-map (lambda (m)
 867 ;                       (gen-insn-doc-list m insns))
 868 ;                     machs)
 869      (string-list-map (lambda (m)
 870                         (let ((mach-insns (find (lambda (insn)
 871                                                   (mach-supports? m insn))
 872                                                 insns)))
 873                           (gen-categories-insn-lists m categories mach-insns)))
 874                       machs)
 875      "<hr>\n"
 876      "<h2>Individual instructions descriptions</h2>\n"
 877      "<br>\n"
 878      (string-list-map gen-insn-doc-1 insns)
 879      ))
 880 )
 881 \f
 882 ; Macro-instruction page.
 883
 884 (define (gen-macro-insn-doc-1 minsn)
 885   (string-list
 886    (gen-obj-doc-header minsn "macro-insn")
 887    "<ul>\n"
 888    "<li>\n"
 889    "syntax: "
 890    "<tt><font size=+2>"
 891    (minsn-syntax minsn)
 892    "</font></tt>\n"
 893    "</li>\n"
 894    "<br>\n"
 895    "<li>\n"
 896    "transformation:\n"
 897    "<font size=+2>\n"
 898    "<pre>" ; no trailing newline here on purpose
 899    (with-output-to-string
 900      (lambda ()
 901        (pretty-print (minsn-expansions minsn))))
 902    "</pre></font>\n"
 903    "</li>\n"
 904    "</ul>\n"
 905    )
 906 )
 907
 908 (define (gen-macro-insn-doc-list mach)
 909   (let ((minsns (find (lambda (minsn)
 910                         (mach-supports? mach minsn))
 911                       (current-minsn-list))))
 912     (string-list
 913      (gen-obj-doc-header mach "mach-macro-insns")
 914      "<ul>\n"
 915      (string-map (lambda (o)
 916                    (gen-obj-list-entry o "macro-insn"))
 917                  minsns)
 918      "</ul>\n"
 919      ))
 920 )
 921
 922 (define (gen-macro-insn-docs)
 923   (let ((machs (current-mach-list))
 924         (minsns (alpha-sort-obj-list (current-minsn-list))))
 925     (string-list
 926      "\n"
 927      "<hr>\n"
 928      "<a name=\"macro-insns\"></a>\n"
 929      "<h2>Macro Instructions</h2>\n"
 930      "Macro instructions for each machine:\n"
 931      "<ul>\n"
 932      (string-map (lambda (o)
 933                    (gen-obj-list-entry o "mach-macro-insns"))
 934                  machs)
 935      "</ul>\n"
 936      (string-list-map gen-macro-insn-doc-list machs)
 937      "<p>\n"
 938      "<h2>Individual macro-instructions descriptions</h2>\n"
 939      "<br>\n"
 940      (string-list-map gen-macro-insn-doc-1 minsns)
 941      ))
 942 )
 943 \f
 944 ; Assembler page.
 945
 946 (define (gen-asm-docs)
 947   (string-list
 948    "\n"
 949    "<hr>\n"
 950    "<a name=\"assembler\"></a>\n"
 951    "<h2>Assembler supplemental</h2>\n"
 952    )
 953 )
 954 \f
 955 ; Documentation init,finish,analyzer support.
 956
 957 ; Initialize any doc specific things before loading the .cpu file.
 958
 959 (define (doc-init!)
 960   (desc-init!)
 961   (mode-set-biggest-word-bitsizes!)
 962   *UNSPECIFIED*
 963 )
 964
 965 ; Finish any doc specific things after loading the .cpu file.
 966 ; This is separate from analyze-data! as cpu-load performs some
 967 ; consistency checks in between.
 968
 969 (define (doc-finish!)
 970   (desc-finish!)
 971   *UNSPECIFIED*
 972 )
 973
 974 ; Compute various needed globals and assign any computed fields of
 975 ; the various objects.  This is the standard routine that is called after
 976 ; a .cpu file is loaded.
 977
 978 (define (doc-analyze!)
 979   (desc-analyze!)
 980
 981   ; If the IDOC attribute isn't defined, provide a default one.
 982   (if (not (current-attr-lookup 'IDOC))
 983       (define-attr
 984         '(for insn)
 985         '(type enum)
 986         '(name IDOC)
 987         '(comment "insn kind for documentation")
 988         '(attrs META)
 989         '(values
 990           (MEM - () "Memory")
 991           (ALU - () "ALU")
 992           (FPU - () "FPU")
 993           (BR - () "Branch")
 994           (MISC - () "Miscellaneous"))))
 995
 996   ; Initialize the rtl->c translator.
 997   (rtl-c-config!)
 998
 999   ; Only include semantic operands when computing the format tables if we're
1000   ; generating operand instance tables.
1001   ; ??? Actually, may always be able to exclude the semantic operands.
1002   ; Still need to traverse the semantics to derive machine computed attributes.
1003   (arch-analyze-insns! CURRENT-ARCH
1004                        #t ; include aliases?
1005                        #f) ; analyze semantics?
1006
1007   *UNSPECIFIED*
1008 )
1009 \f
1010 ; Top level C code generators
1011
1012 ; Set by the -N argument.
1013 (define *insn-html-file-name* "unspecified.html")
1014
1015 (define (cgen.html)
1016   (logit 1 "Generating " (current-arch-name) ".html ...\n")
1017   (string-write
1018    (gen-html-copyright (string-append "Architecture documentation for "
1019                                       (symbol->string (current-arch-name))
1020                                       ".")
1021                        CURRENT-COPYRIGHT CURRENT-PACKAGE)
1022    (gen-html-header "Architecture")
1023    (gen-table-of-contents *insn-html-file-name*)
1024    gen-arch-intro
1025    gen-machine-docs
1026    gen-model-docs
1027    gen-register-docs
1028    gen-asm-docs
1029    gen-html-trailer
1030    )
1031 )
1032
1033 (define (cgen-insn.html)
1034   (logit 1 "Generating " (current-arch-name) "-insn.html ...\n")
1035   (string-write
1036    (gen-html-copyright (string-append "Instruction documentation for "
1037                                       (symbol->string (current-arch-name))
1038                                       ".")
1039                        CURRENT-COPYRIGHT CURRENT-PACKAGE)
1040    (gen-html-header "Instruction")
1041    gen-insn-docs
1042    gen-macro-insn-docs
1043    gen-html-trailer
1044    )
1045 )
1046
1047 ; For debugging.
1048
1049 (define (cgen-all)
1050   (string-write
1051    cgen.html
1052    cgen-insn.html
1053    )
1054 )