ghc/utils/parallel/GrAnSim.el

   1 ;; ---------------------------------------------------------------------------
   2 ;; Time-stamp: <Tue Jun 11 1996 18:01:28 Stardate: [-31]7643.54 hwloidl>
   3 ;;
   4 ;; Mode for GrAnSim profiles
   5 ;; ---------------------------------------------------------------------------
   6
   7 (defvar gransim-auto-hilit t
   8   "Automagically invoke hilit19.")
   9
  10 (defvar grandir (getenv "GRANDIR")
  11   "Root of the GrAnSim installation. Executables should be in grandir/bin")
  12
  13 (defvar hwl-hi-node-face 'highlight
  14   "Face to be used for specific highlighting of a node")
  15
  16 (defvar hwl-hi-thread-face 'holiday-face
  17   "Face to be used for specific highlighting of a thread")
  18
  19 ;; ---------------------------------------------------------------------------
  20
  21 (setq exec-path (cons (concat grandir "/bin") exec-path))
  22
  23 ;; Requires hilit19 for highlighting parts of a GrAnSim profile
  24 (cond (window-system
  25    (setq hilit-mode-enable-list  '(not text-mode)
  26          hilit-background-mode   'light
  27          hilit-inhibit-hooks     nil
  28          hilit-inhibit-rebinding nil);
  29
  30    (require 'hilit19)
  31 ))
  32
  33
  34 (setq auto-mode-alist
  35       (append '(("\\.gr" . gr-mode))
  36              auto-mode-alist))
  37
  38 (defvar gr-mode-map (make-keymap "GrAnSim Profile Mode SetUp")
  39   "Keymap for GrAnSim profiles.")
  40
  41 ; (fset 'GrAnSim-mode-fiddly gr-mode-map)
  42
  43 ;(define-key gr-mode-map [wrap]
  44 ;  '("Wrap lines" . hwl-wrap))
  45
  46 ;(define-key gr-mode-map [truncate]
  47 ;  '("Truncate lines" . hwl-truncate))
  48
  49 ;(define-key global-map [C-S-down-mouse-1] 'GrAnSim-mode-fiddly)
  50
  51 ;(modify-frame-parameters (selected-frame)
  52 ;                         '((menu-bar-lines . 2)))
  53
  54 ;(define-key-after gr-mode-map [menu-bar GrAnSim]
  55 ;  '("GrAnSim" . (make-sparse-keymap "GrAnSim")) 'edit)
  56
  57 ;(defvar GrAnSim-menu-map (make-sparse-keymap "GrAnSim"))
  58
  59 (define-key gr-mode-map [menu-bar GrAnSim]
  60   (cons "GrAnSim"  (make-sparse-keymap "GrAnSim"))) ;  'edit)
  61
  62 (define-key gr-mode-map [menu-bar GrAnSim wrap]
  63   '("Wrap lines" . hwl-wrap))
  64
  65 (define-key gr-mode-map [menu-bar GrAnSim truncate]
  66   '("Truncate lines" . hwl-truncate))
  67
  68 (define-key gr-mode-map [menu-bar GrAnSim toggle-truncate]
  69   '("Toggle truncate/wrap" . hwl-toggle-truncate-wrap) )
  70
  71 (define-key gr-mode-map [menu-bar GrAnSim hi-clear]
  72   '("Clear highlights" . hwl-hi-clear))
  73
  74 (define-key gr-mode-map [menu-bar GrAnSim hi-thread]
  75   '("Highlight specific Thread" . hwl-hi-thread))
  76
  77 (define-key gr-mode-map [menu-bar GrAnSim hi-node]
  78   '("Highlight specific Node" . hwl-hi-node))
  79
  80 (define-key gr-mode-map [menu-bar GrAnSim highlight]
  81   '("Highlight buffer" . hilit-rehighlight-buffer))
  82
  83 (define-key gr-mode-map [menu-bar GrAnSim narrow-event]
  84   '("Narrow to Event" . hwl-narrow-to-event))
  85
  86 (define-key gr-mode-map [menu-bar GrAnSim narrow-thread]
  87   '("Narrow to Thread" . hwl-narrow-to-thread))
  88
  89 (define-key gr-mode-map [menu-bar GrAnSim narrow-pe]
  90   '("Narrow to PE" . hwl-narrow-to-pe))
  91
  92
  93
  94 ; (define-key global-map [C-S-down-mouse-1] 'GrAnSim-mode-fiddly)
  95
  96
  97 (defvar gr-mode-hook nil
  98   "Invoked in gr mode.")
  99
 100
 101 ;;; Ensure new buffers won't get this mode if default-major-mode is nil.
 102 ;(put 'gr-mode 'mode-class 'special)
 103
 104 (defun gr-mode ()
 105   "Major mode for GrAnSim profiles."
 106   (interactive)
 107   (kill-all-local-variables)
 108   ;(use-local-map gr-mode-map)
 109   (use-local-map gr-mode-map)     ; This provides the local keymap.
 110   (setq major-mode 'gr-mode)
 111   (setq mode-name "GrAnSim Profile Mode")
 112   (setq local-abbrev-table text-mode-abbrev-table)
 113   (set-syntax-table text-mode-syntax-table)
 114   (setq truncate-lines t)         ; do not wrap lines (truncates END lines!)
 115   (auto-save-mode -1)
 116   ;(setq buffer-offer-save t)
 117   (run-hooks 'gr-mode-hook))
 118
 119 ;; same as mh-make-local-vars
 120 (defun gr-make-local-vars (&rest pairs)
 121   ;; Take VARIABLE-VALUE pairs and make local variables initialized to the
 122   ;; value.
 123   (while pairs
 124     (make-variable-buffer-local (car pairs))
 125     (set (car pairs) (car (cdr pairs)))
 126     (setq pairs (cdr (cdr pairs)))))
 127
 128 ;; ----------------------------------------------------------------------
 129 ;; Highlighting stuff (currently either hilit19 or fontlock is used)
 130 ;; ----------------------------------------------------------------------
 131
 132 (hilit-set-mode-patterns
 133    'gr-mode
 134    '(;; comments
 135         ("--.*$" nil comment)
 136         ("\\+\\+.*$" nil comment)
 137         ;; hilight important bits in the header
 138         ("^Granularity Simulation for \\(.*\\)$" 1 glob-struct)
 139         ("^PEs[ \t]+\\([0-9]+\\)" 1 decl)
 140         ("^Latency[ \t]+\\([0-9]+\\)" 1 decl)
 141         ("Arith[ \t]+\\([0-9]+\\)" 1 decl)
 142         ("Branch[ \t]+\\([0-9]+\\)" 1 decl)
 143         ("Load[ \t]+\\([0-9]+\\)" 1 decl)
 144         ("Store[ \t]+\\([0-9]+\\)" 1 decl)
 145         ("Float[ \t]+\\([0-9]+\\)" 1 decl)
 146         ("Alloc[ \t]+\\([0-9]+\\)" 1 decl)
 147         ;; hilight PE number and time in each line
 148         ("^PE[ \t]+\\([0-9]+\\)" 1 glob-struct)
 149         (" \\[\\([0-9]+\\)\\]:" 1 define)
 150         ;; in this case the events are the keyword
 151                                         ; ("\\(FETCH\\|REPLY\\|RESUME\\|RESUME(Q)\\|SCHEDULE\\|SCHEDULE(Q)\\|BLOCK\\|STEALING\\|STOLEN\\|STOLEN(Q)\\)[ \t]" 1 keyword)
 152         ("\\(FETCH\\|BLOCK\\)[ \t]" 1 label)
 153         ("\\(REPLY\\|RESUME(Q)\\|SCHEDULE(Q)\\|STOLEN(Q)\\)[ \t]" 1 named-param)
 154         ("\\(RESUME\\|SCHEDULE\\|STOLEN\\)[ \t]" 1 msg-quote)
 155         ("\\(STEALING\\)[ \t]" 1 keyword)
 156         ("\\(START\\|END\\)[ \t]" 1 defun)
 157         ("\\(SPARK\\|SPARKAT\\|USED\\|PRUNED\\)[ \t]" 1 crossref)
 158         ("\\(EXPORTED\\|ACQUIRED\\)[ \t]" 1 string)
 159         ;; especially interesting are END events; hightlight runtime etc
 160         (",[ \t]+RT[ \t]+\\([0-9]+\\)" 1 define)
 161         ;; currently unused but why not?
 162         ("\"" ".*\"" string))
 163 )
 164
 165 ;; --------------------------------------------------------------------------
 166 ;; Own fcts for selective highlighting
 167 ;; --------------------------------------------------------------------------
 168
 169 (defun hwl-hi-node (node)
 170  "Highlight node in GrAnSim profile."
 171  (interactive "sNode (hex): ")
 172  (save-excursion
 173   (let* ( (here (point))
 174           (len (length node)) )
 175   (goto-char (point-min))
 176   (while (search-forward node nil t)
 177          (let* ( (end (point))
 178                  (start (- end len)) )
 179                (add-text-properties start end `(face ,hwl-hi-node-face))
 180          )
 181   ) )
 182  )
 183 )
 184
 185 (defun hwl-hi-thread (task)
 186  "Highlight task in GrAnSim profile."
 187  (interactive "sTask: ")
 188  (save-excursion
 189   (let* ( (here (point))
 190           (len (length task))
 191           (se-str (format "[A-Z)]\\s-+%s\\(\\s-\\|,\\)" task))
 192         )
 193   (goto-char (point-min))
 194   (while (re-search-forward se-str nil t)
 195     (let ( (c (current-column)) )
 196          (if (and (> c 10) (< c 70))
 197             (let* ( (end (1- (point)))
 198                     (start (- end len)) )
 199                   (add-text-properties start end `(face ,hwl-hi-thread-face))
 200          ) ) )
 201   ) )
 202  )
 203 )
 204
 205 (defun hwl-hi-line ()
 206  "Highlight the current line."
 207  (interactive)
 208  (save-excursion
 209   (beginning-of-line)
 210   (let ( (beg (point)) )
 211        (end-of-line)
 212        (add-text-properties beg (point) '(face highlight))
 213   )
 214  )
 215 )
 216
 217 (defun hwl-unhi-line ()
 218  "Unhighlight the current line."
 219  (interactive)
 220  (save-excursion
 221   (beginning-of-line)
 222   (let ( (beg (point)) )
 223        (end-of-line)
 224        (add-text-properties beg (point) '(face nil))
 225   )
 226  )
 227 )
 228
 229 ; Doesn't work yet
 230 (defun hwl-hi-from-to (from to)
 231  "Highlight region between two timestamps."
 232  (interactive "nFrom: \nnTo:")
 233  (save-excursion
 234   (let* ( (here (point))
 235           (now 0)
 236           start end
 237           (separator '"+++++")
 238         )
 239   (goto-char (point-min))
 240     ; (re-search-forward REGEXP)
 241   (search-forward separator nil t)
 242   (forward-line)
 243   (while (< now from)
 244     (beginning-of-line)
 245     (forward-line)
 246     (forward-char 7)
 247     (setq beg (point))
 248     (search-forward "]")
 249     (setq time-str (buffer-substring beg (- (point) 2)))
 250     (setq now (string-to-number time-str))
 251   )
 252   (if (< now from)
 253     nil
 254     (setq start (point))
 255     (while (< now to)
 256       (beginning-of-line)
 257       (forward-line)
 258       (forward-char 7)
 259       (setq beg (point))
 260       (search-forward "]")
 261       (setq time-str (buffer-substring beg (- (point) 2)))
 262       (setq now (string-to-number time-str))
 263     )
 264     (if (< now to)
 265       nil
 266       (setq end (point))
 267       (add-text-properties start end '(face paren-match-face))
 268          )
 269    )
 270   ) ; let
 271  ) ; excursion
 272 )
 273
 274 (defun hwl-hi-clear ()
 275   (interactive)
 276   (let ( (start (point-min) )
 277          (end (point-max)) )
 278        (remove-text-properties start end '(face nil))
 279   )
 280 )
 281
 282 ;; --------------------------------------------------------------------------
 283 ;; Misc Elisp functions
 284 ;; --------------------------------------------------------------------------
 285
 286 (defun hwl-wrap ()
 287   (interactive)
 288   (setq truncate-lines nil)
 289   (hilit-recenter nil)
 290 )
 291
 292 (defun hwl-truncate ()
 293   (interactive)
 294   (setq truncate-lines t)
 295   (hilit-recenter nil)
 296 )
 297
 298 (defun hwl-toggle-truncate-wrap ()
 299   (interactive)
 300   (if truncate-lines (setq truncate-lines nil)
 301                      (setq truncate-lines t))
 302   (hilit-recenter nil)
 303 )
 304
 305 (defun hwl-narrow-to-pe (pe)
 306     (interactive "nPE: ")
 307     (hwl-narrow 1 pe "")
 308 )
 309
 310 (defun hwl-narrow-to-thread (thread)
 311     (interactive "sThread: ")
 312     (hwl-narrow 2 thread "")
 313 )
 314
 315 (defun hwl-narrow-to-event (event)
 316     (interactive "sEvent: ")
 317     (hwl-narrow 3 0 event)
 318 )
 319
 320 (defun hwl-narrow (mode id str)
 321   ( let* ((outbuffer (get-buffer-create "*GrAnSim Narrowed*"))
 322          ;(from (beginning-of-buffer))
 323          ;(to   (end-of-buffer))
 324          ;(to   (point))                            ; (region-end))
 325          ;(text (buffer-substring from to))         ; contains text in region
 326          (w    (selected-window))
 327          ;(nh   5)                                  ; height of new window
 328          ;(h    (window-height w))                  ; height of selcted window
 329          ;(h1   (if (<= h nh) (- h 1) (- h nh)))    ; height of old window
 330          (w1   (get-buffer-window outbuffer 'visible))
 331
 332          (infile (buffer-file-name))                ; or
 333          (inbuffer (current-buffer))
 334          (command "tf")
 335          ;(mode_opt (cond ((eq mode 1) "-p")
 336          ;               ((eq mode 2) "-t")
 337          ;               ((eq mode 3) "-e")
 338          ;               (t "-v")))
 339         )
 340         (if w1 (message "Window *GrAnSim Narrowed* already visible")
 341                (split-window w nil nil))
 342         (switch-to-buffer-other-window outbuffer)
 343         (erase-buffer)
 344         (setq truncate-lines t)
 345         (gr-mode)
 346         ;(beginning-of-buffer)
 347         ;(set-mark)
 348         ;(end-of-buffer)
 349         ;(delete-region region-beginning region-end)
 350         (cond ((eq mode 1)
 351                ;(message (format "Narrowing to Processor %d" id))
 352                 (call-process command nil outbuffer t "-p" (format "%d" id) infile ))
 353               ((eq mode 2)
 354                ;(message (format "Narrowing to Thread %d" id))
 355                 (call-process command nil outbuffer t "-t" (format "%s" id) infile ))
 356               ((eq mode 3)
 357                ;(message (format "Narrowing to Event %s" str))
 358                 (call-process command nil outbuffer t "-e" str infile ))
 359               )
 360   )
 361 )
 362
 363 (defun hwl-command-on-buffer (prg opts file)
 364   (interactice "CProgram:\nsOptions:\nfFile:")
 365   ( let* ((outbuffer (get-buffer-create "*GrAnSim Command*"))
 366          (from (beginning-of-buffer))
 367          (to   (end-of-buffer))
 368          ;(to   (point))                            ; (region-end))
 369          ;(text (buffer-substring from to))         ; contains text in region
 370          (w    (selected-window))
 371          ;(nh   5)                                  ; height of new window
 372          ;(h    (window-height w))                  ; height of selcted window
 373          ;(h1   (if (<= h nh) (- h 1) (- h nh)))    ; height of old window
 374          (w1   (get-buffer-window outbuffer 'visible))
 375
 376          (infile (buffer-file-name))                ; or
 377          (inbuffer (current-buffer))
 378          ;(command "tf")
 379          ;(mode_opt (cond ((eq mode 1) "-p")
 380          ;               ((eq mode 2) "-t")
 381          ;               ((eq mode 3) "-e")
 382          ;               (t "-v")))
 383         )
 384         (if w1 (message "Window *GrAnSim Command* already visible")
 385                (split-window w nil nil))
 386         (switch-to-buffer-other-window outbuffer)
 387         (erase-buffer)
 388         (setq truncate-lines t)
 389         (gr-mode)
 390         (call-process prg nil outbuffer opts file)
 391   )
 392 )
 393
 394 ;; ToDo: Elisp Fcts for calling scripts like gr3ps etc
 395
 396 (define-key gr-mode-map "\C-ct" 'hwl-truncate)
 397 (define-key gr-mode-map "\C-cw" 'hwl-wrap)
 398 (define-key gr-mode-map "\C-ch" 'hilit-rehighlight-buffer)
 399 (define-key gr-mode-map "\C-cp" 'hwl-narrow-to-pe)
 400 (define-key gr-mode-map "\C-ct" 'hwl-narrow-to-thread)
 401 (define-key gr-mode-map "\C-ce" 'hwl-narrow-to-event)
 402 (define-key gr-mode-map "\C-c\C-e" '(lambda () (hwl-narrow-to-event "END")))
 403 (define-key gr-mode-map "\C-c " 'hwl-toggle-truncate-wrap)
 404 (define-key gr-mode-map "\C-cN" 'hwl-hi-node)
 405 (define-key gr-mode-map "\C-cT" 'hwl-hi-thread)
 406 (define-key gr-mode-map "\C-c\C-c" 'hwl-hi-clear)
 407
 408 ;; ---------------------------------------------------------------------------
 409 ;; Mode for threaded C files
 410 ;; ---------------------------------------------------------------------------
 411
 412 (setq auto-mode-alist
 413       (append '(("\\.hc" . hc-mode))
 414              auto-mode-alist))
 415
 416 (define-derived-mode hc-mode c-mode "hc Mode"
 417   "Derived mode for Haskell C files."
 418 )
 419
 420 (hilit-set-mode-patterns
 421       'hc-mode
 422       '(
 423         ("\\(GRAN_FETCH\\|GRAN_RESCHEDULE\\|GRAN_FETCH_AND_RESCHEDULE\\|GRAN_EXEC\\|GRAN_YIELD\\)" 1 keyword)
 424         ("FB_" nil defun)
 425         ("FE_" nil  define)
 426         ("__STG_SPLIT_MARKER" nil msg-note)
 427         ("^.*_ITBL.*$" nil defun)
 428         ("^\\(I\\|E\\|\\)FN.*$" nil define)
 429         )
 430 )
 431
 432 ; (define-key global-map [S-pause] 'hc-mode)