--- /dev/null
+;; ---------------------------------------------------------------------------
+;; 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)
projects / ghc-hetmet.git / blobdiff