path: root/ghc/utils/parallel/GrAnSim.el

;; ---------------------------------------------------------------------------
;; Time-stamp: <Tue Jun 11 1996 18:01:28 Stardate: [-31]7643.54 hwloidl>
;;
;; Mode for GrAnSim profiles
;; ---------------------------------------------------------------------------

(defvar gransim-auto-hilit t
  "Automagically invoke hilit19.")

(defvar	grandir (getenv "GRANDIR")
  "Root of the GrAnSim installation. Executables should be in grandir/bin")

(defvar hwl-hi-node-face 'highlight
  "Face to be used for specific highlighting of a node")

(defvar hwl-hi-thread-face 'holiday-face
  "Face to be used for specific highlighting of a thread")

;; ---------------------------------------------------------------------------

(setq exec-path (cons (concat grandir "/bin") exec-path))

;; Requires hilit19 for highlighting parts of a GrAnSim profile
(cond (window-system
   (setq hilit-mode-enable-list  '(not text-mode)
         hilit-background-mode   'light
         hilit-inhibit-hooks     nil
         hilit-inhibit-rebinding nil);

   (require 'hilit19)
))


(setq auto-mode-alist
      (append '(("\\.gr" . gr-mode))
	     auto-mode-alist))

(defvar gr-mode-map (make-keymap "GrAnSim Profile Mode SetUp")
  "Keymap for GrAnSim profiles.")

; (fset 'GrAnSim-mode-fiddly gr-mode-map)

;(define-key gr-mode-map [wrap]
;  '("Wrap lines" . hwl-wrap))

;(define-key gr-mode-map [truncate]
;  '("Truncate lines" . hwl-truncate))

;(define-key global-map [C-S-down-mouse-1] 'GrAnSim-mode-fiddly)

;(modify-frame-parameters (selected-frame)
;                         '((menu-bar-lines . 2)))

;(define-key-after gr-mode-map [menu-bar GrAnSim]
;  '("GrAnSim" . (make-sparse-keymap "GrAnSim")) 'edit)

;(defvar GrAnSim-menu-map (make-sparse-keymap "GrAnSim"))

(define-key gr-mode-map [menu-bar GrAnSim]
  (cons "GrAnSim"  (make-sparse-keymap "GrAnSim"))) ;  'edit)

(define-key gr-mode-map [menu-bar GrAnSim wrap]
  '("Wrap lines" . hwl-wrap))

(define-key gr-mode-map [menu-bar GrAnSim truncate]
  '("Truncate lines" . hwl-truncate))

(define-key gr-mode-map [menu-bar GrAnSim toggle-truncate]
  '("Toggle truncate/wrap" . hwl-toggle-truncate-wrap) )

(define-key gr-mode-map [menu-bar GrAnSim hi-clear]
  '("Clear highlights" . hwl-hi-clear))

(define-key gr-mode-map [menu-bar GrAnSim hi-thread]
  '("Highlight specific Thread" . hwl-hi-thread))

(define-key gr-mode-map [menu-bar GrAnSim hi-node]
  '("Highlight specific Node" . hwl-hi-node))

(define-key gr-mode-map [menu-bar GrAnSim highlight]
  '("Highlight buffer" . hilit-rehighlight-buffer))

(define-key gr-mode-map [menu-bar GrAnSim narrow-event]
  '("Narrow to Event" . hwl-narrow-to-event))

(define-key gr-mode-map [menu-bar GrAnSim narrow-thread]
  '("Narrow to Thread" . hwl-narrow-to-thread))

(define-key gr-mode-map [menu-bar GrAnSim narrow-pe]
  '("Narrow to PE" . hwl-narrow-to-pe))



; (define-key global-map [C-S-down-mouse-1] 'GrAnSim-mode-fiddly)
     

(defvar gr-mode-hook nil
  "Invoked in gr mode.")


;;; Ensure new buffers won't get this mode if default-major-mode is nil.
;(put 'gr-mode 'mode-class 'special)

(defun gr-mode ()
  "Major mode for GrAnSim profiles."
  (interactive)
  (kill-all-local-variables)
  ;(use-local-map gr-mode-map)
  (use-local-map gr-mode-map)     ; This provides the local keymap.
  (setq major-mode 'gr-mode)
  (setq mode-name "GrAnSim Profile Mode")
  (setq local-abbrev-table text-mode-abbrev-table)
  (set-syntax-table text-mode-syntax-table)
  (setq truncate-lines t)         ; do not wrap lines (truncates END lines!)
  (auto-save-mode -1)
  ;(setq buffer-offer-save t)
  (run-hooks 'gr-mode-hook))

;; same as mh-make-local-vars
(defun gr-make-local-vars (&rest pairs)
  ;; Take VARIABLE-VALUE pairs and make local variables initialized to the
  ;; value.
  (while pairs
    (make-variable-buffer-local (car pairs))
    (set (car pairs) (car (cdr pairs)))
    (setq pairs (cdr (cdr pairs)))))

;; ----------------------------------------------------------------------
;; Highlighting stuff (currently either hilit19 or fontlock is used)
;; ----------------------------------------------------------------------

(hilit-set-mode-patterns
   'gr-mode
   '(;; comments
	("--.*$" nil comment)
	("\\+\\+.*$" nil comment)
	;; hilight important bits in the header
	("^Granularity Simulation for \\(.*\\)$" 1 glob-struct)
	("^PEs[ \t]+\\([0-9]+\\)" 1 decl)
	("^Latency[ \t]+\\([0-9]+\\)" 1 decl)
	("Arith[ \t]+\\([0-9]+\\)" 1 decl)
	("Branch[ \t]+\\([0-9]+\\)" 1 decl)
	("Load[ \t]+\\([0-9]+\\)" 1 decl)
	("Store[ \t]+\\([0-9]+\\)" 1 decl)
	("Float[ \t]+\\([0-9]+\\)" 1 decl)
	("Alloc[ \t]+\\([0-9]+\\)" 1 decl)
	;; hilight PE number and time in each line
	("^PE[ \t]+\\([0-9]+\\)" 1 glob-struct)
	(" \\[\\([0-9]+\\)\\]:" 1 define)
	;; in this case the events are the keyword
					; ("\\(FETCH\\|REPLY\\|RESUME\\|RESUME(Q)\\|SCHEDULE\\|SCHEDULE(Q)\\|BLOCK\\|STEALING\\|STOLEN\\|STOLEN(Q)\\)[ \t]" 1 keyword)
	("\\(FETCH\\|BLOCK\\)[ \t]" 1 label)
	("\\(REPLY\\|RESUME(Q)\\|SCHEDULE(Q)\\|STOLEN(Q)\\)[ \t]" 1 named-param)
	("\\(RESUME\\|SCHEDULE\\|STOLEN\\)[ \t]" 1 msg-quote)
	("\\(STEALING\\)[ \t]" 1 keyword)
	("\\(START\\|END\\)[ \t]" 1 defun)
	("\\(SPARK\\|SPARKAT\\|USED\\|PRUNED\\)[ \t]" 1 crossref)
	("\\(EXPORTED\\|ACQUIRED\\)[ \t]" 1 string)
	;; especially interesting are END events; hightlight runtime etc
	(",[ \t]+RT[ \t]+\\([0-9]+\\)" 1 define)
	;; currently unused but why not?
	("\"" ".*\"" string))
)

;; --------------------------------------------------------------------------
;; Own fcts for selective highlighting
;; --------------------------------------------------------------------------

(defun hwl-hi-node (node)
 "Highlight node in GrAnSim profile."
 (interactive "sNode (hex): ")
 (save-excursion 
  (let* ( (here (point))
	  (len (length node)) )
  (goto-char (point-min))
  (while (search-forward node nil t)
         (let* ( (end (point))
                 (start (- end len)) )
               (add-text-properties start end `(face ,hwl-hi-node-face))
         )
  ) )
 )
)

(defun hwl-hi-thread (task)
 "Highlight task in GrAnSim profile."
 (interactive "sTask: ")
 (save-excursion 
  (let* ( (here (point))
	  (len (length task))
	  (se-str (format "[A-Z)]\\s-+%s\\(\\s-\\|,\\)" task))
        )
  (goto-char (point-min))
  (while (re-search-forward se-str nil t)
    (let ( (c (current-column)) )
         (if (and (> c 10) (< c 70))
            (let* ( (end (1- (point)))
                    (start (- end len)) )
                  (add-text-properties start end `(face ,hwl-hi-thread-face))
         ) ) )
  ) )
 )
)

(defun hwl-hi-line ()
 "Highlight the current line."
 (interactive)
 (save-excursion
  (beginning-of-line)
  (let ( (beg (point)) )
       (end-of-line)
       (add-text-properties beg (point) '(face highlight))
  )
 )
)

(defun hwl-unhi-line ()
 "Unhighlight the current line."
 (interactive)
 (save-excursion
  (beginning-of-line)
  (let ( (beg (point)) )
       (end-of-line)
       (add-text-properties beg (point) '(face nil))
  )
 )
)

; Doesn't work yet
(defun hwl-hi-from-to (from to)
 "Highlight region between two timestamps."
 (interactive "nFrom: \nnTo:")
 (save-excursion 
  (let* ( (here (point))
	  (now 0)
	  start end 
	  (separator '"+++++")
        )
  (goto-char (point-min))
    ; (re-search-forward REGEXP)
  (search-forward separator nil t)
  (forward-line)
  (while (< now from) 
    (beginning-of-line)
    (forward-line)
    (forward-char 7)
    (setq beg (point))
    (search-forward "]")
    (setq time-str (buffer-substring beg (- (point) 2)))
    (setq now (string-to-number time-str))
  )
  (if (< now from)
    nil
    (setq start (point))
    (while (< now to) 
      (beginning-of-line)
      (forward-line)
      (forward-char 7)
      (setq beg (point))
      (search-forward "]")
      (setq time-str (buffer-substring beg (- (point) 2)))
      (setq now (string-to-number time-str))
    )
    (if (< now to)
      nil
      (setq end (point))
      (add-text-properties start end '(face paren-match-face))
         )
   ) 
  ) ; let
 ) ; excursion
)

(defun hwl-hi-clear ()
  (interactive)
  (let ( (start (point-min) )
         (end (point-max)) )
       (remove-text-properties start end '(face nil))
  )
)

;; --------------------------------------------------------------------------
;; Misc Elisp functions
;; --------------------------------------------------------------------------

(defun hwl-wrap ()
  (interactive)
  (setq truncate-lines nil)
  (hilit-recenter nil)
)

(defun hwl-truncate ()
  (interactive)
  (setq truncate-lines t)
  (hilit-recenter nil)
)

(defun hwl-toggle-truncate-wrap ()
  (interactive)
  (if truncate-lines (setq truncate-lines nil)
                     (setq truncate-lines t))
  (hilit-recenter nil)
)

(defun hwl-narrow-to-pe (pe)
    (interactive "nPE: ")
    (hwl-narrow 1 pe "")
)

(defun hwl-narrow-to-thread (thread)
    (interactive "sThread: ")
    (hwl-narrow 2 thread "")
)

(defun hwl-narrow-to-event (event)
    (interactive "sEvent: ")
    (hwl-narrow 3 0 event)
)

(defun hwl-narrow (mode id str)
  ( let* ((outbuffer (get-buffer-create "*GrAnSim Narrowed*"))
	 ;(from (beginning-of-buffer))
	 ;(to   (end-of-buffer))
	 ;(to   (point))                            ; (region-end))
	 ;(text (buffer-substring from to))         ; contains text in region
	 (w    (selected-window))		   
	 ;(nh   5)                                  ; height of new window
	 ;(h    (window-height w))                  ; height of selcted window
	 ;(h1   (if (<= h nh) (- h 1) (- h nh)))    ; height of old window
	 (w1   (get-buffer-window outbuffer 'visible))

	 (infile (buffer-file-name))                ; or 
	 (inbuffer (current-buffer))
	 (command "tf")
	 ;(mode_opt (cond ((eq mode 1) "-p")
	 ;	         ((eq mode 2) "-t")
	 ;	         ((eq mode 3) "-e")
	 ;		 (t "-v")))
	)
        (if w1 (message "Window *GrAnSim Narrowed* already visible") 
               (split-window w nil nil))
        (switch-to-buffer-other-window outbuffer)
	(erase-buffer)
	(setq truncate-lines t)
	(gr-mode)
	;(beginning-of-buffer)
	;(set-mark)
	;(end-of-buffer)
	;(delete-region region-beginning region-end)
	(cond ((eq mode 1)
	       ;(message (format "Narrowing to Processor %d" id))
		(call-process command nil outbuffer t "-p" (format "%d" id) infile ))
	      ((eq mode 2)
	       ;(message (format "Narrowing to Thread %d" id))
		(call-process command nil outbuffer t "-t" (format "%s" id) infile ))
	      ((eq mode 3)
	       ;(message (format "Narrowing to Event %s" str))
		(call-process command nil outbuffer t "-e" str infile ))
	      )
  )
)

(defun hwl-command-on-buffer (prg opts file)
  (interactice "CProgram:\nsOptions:\nfFile:")
  ( let* ((outbuffer (get-buffer-create "*GrAnSim Command*"))
	 (from (beginning-of-buffer))
	 (to   (end-of-buffer))
	 ;(to   (point))                            ; (region-end))
	 ;(text (buffer-substring from to))         ; contains text in region
	 (w    (selected-window))		   
	 ;(nh   5)                                  ; height of new window
	 ;(h    (window-height w))                  ; height of selcted window
	 ;(h1   (if (<= h nh) (- h 1) (- h nh)))    ; height of old window
	 (w1   (get-buffer-window outbuffer 'visible))

	 (infile (buffer-file-name))                ; or 
	 (inbuffer (current-buffer))
	 ;(command "tf")
	 ;(mode_opt (cond ((eq mode 1) "-p")
	 ;	         ((eq mode 2) "-t")
	 ;	         ((eq mode 3) "-e")
	 ;		 (t "-v")))
	)
        (if w1 (message "Window *GrAnSim Command* already visible") 
               (split-window w nil nil))
        (switch-to-buffer-other-window outbuffer)
	(erase-buffer)
	(setq truncate-lines t)
	(gr-mode)
	(call-process prg nil outbuffer opts file)
  )
)

;; ToDo: Elisp Fcts for calling scripts like gr3ps etc

(define-key gr-mode-map "\C-ct" 'hwl-truncate)
(define-key gr-mode-map "\C-cw" 'hwl-wrap)
(define-key gr-mode-map "\C-ch" 'hilit-rehighlight-buffer)
(define-key gr-mode-map "\C-cp" 'hwl-narrow-to-pe)
(define-key gr-mode-map "\C-ct" 'hwl-narrow-to-thread)
(define-key gr-mode-map "\C-ce" 'hwl-narrow-to-event)
(define-key gr-mode-map "\C-c\C-e" '(lambda () (hwl-narrow-to-event "END")))
(define-key gr-mode-map "\C-c " 'hwl-toggle-truncate-wrap)
(define-key gr-mode-map "\C-cN" 'hwl-hi-node)
(define-key gr-mode-map "\C-cT" 'hwl-hi-thread)
(define-key gr-mode-map "\C-c\C-c" 'hwl-hi-clear)

;; ---------------------------------------------------------------------------
;; Mode for threaded C files
;; ---------------------------------------------------------------------------

(setq auto-mode-alist
      (append '(("\\.hc" . hc-mode))
	     auto-mode-alist))

(define-derived-mode hc-mode c-mode "hc Mode"
  "Derived mode for Haskell C files."
)

(hilit-set-mode-patterns
      'hc-mode
      '(
	("\\(GRAN_FETCH\\|GRAN_RESCHEDULE\\|GRAN_FETCH_AND_RESCHEDULE\\|GRAN_EXEC\\|GRAN_YIELD\\)" 1 keyword)
	("FB_" nil defun)
	("FE_" nil  define)
	("__STG_SPLIT_MARKER" nil msg-note)
	("^.*_ITBL.*$" nil defun)
	("^\\(I\\|E\\|\\)FN.*$" nil define)
	)
)

; (define-key global-map [S-pause] 'hc-mode)