X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Futils%2Fparallel%2FGrAnSim.el;fp=ghc%2Futils%2Fparallel%2FGrAnSim.el;h=0000000000000000000000000000000000000000;hb=0065d5ab628975892cea1ec7303f968c3338cbe1;hp=49330a9749843d94f8bf981032df520f38f79010;hpb=28a464a75e14cece5db40f2765a29348273ff2d2;p=ghc-hetmet.git diff --git a/ghc/utils/parallel/GrAnSim.el b/ghc/utils/parallel/GrAnSim.el deleted file mode 100644 index 49330a9..0000000 --- a/ghc/utils/parallel/GrAnSim.el +++ /dev/null @@ -1,432 +0,0 @@ -;; --------------------------------------------------------------------------- -;; Time-stamp: -;; -;; 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)