;;; lmc.el --- Little Man Computer in Elisp
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2013 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
-;; Version: 1.0
+;; Version: 1.2
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
(eval-when-compile (require 'cl))
(require 'hexl)
+(defgroup lmc ()
+ "Customization group for the Little Man Computer simulator."
+ :group 'languages)
+
;;; The LMC-Simulator
(defvar lmc--pc 0 "Program counter for LMC.")
(defvar lmc-acc 0 "Accumulator for LMC.")
(make-variable-buffer-local 'lmc--acc)
+(defvar lmc-turbo nil
+ "When non-nil, evaluate the code without extra delays.
+When nil, evaluation flashes the cursor at to help you see what's going on,
+which slows it down significantly.
+Also, when nil, evaluation is interrupted when the user hits a key.")
+
+;; Emacs-22 backward compatibility.
+(defmacro lmc--with-silent-modifications (&rest body)
+ (declare (debug t) (indent 0))
+ (if (fboundp 'with-silent-modifications)
+ `(with-silent-modifications ,@body)
+ (let ((modified (make-symbol "modified")))
+ `(let* ((,modified (buffer-modified-p))
+ (buffer-undo-list t)
+ (inhibit-read-only t)
+ (inhibit-modification-hooks t)
+ deactivate-mark
+ ;; Avoid setting and removing file locks and checking
+ ;; buffer's uptodate-ness w.r.t the underlying file.
+ buffer-file-name
+ buffer-file-truename)
+ (unwind-protect
+ (progn
+ ,@body)
+ (unless ,modified
+ (restore-buffer-modified-p nil)))))))
+
;; (defun lmc-check (cmds)
;; (dolist (cmd cmds)
;; (pcase cmd
(setq addr (1+ addr))))
(lmc-update-pc))
-(defvar lmc-store-flash t)
+(defcustom lmc-store-flash t
+ "If non-nil, memory words blink when modified."
+ :type 'boolean)
+
+(defun lmc--sit-for (secs)
+ (unless lmc-turbo (sit-for secs)))
(defun lmc-store-word (addr word)
(save-excursion
(lmc-addr->point addr)
(if (not (re-search-forward "\t.*\t\\(.*\\)$" (line-end-position) t))
(error "Missing memory cell %S" addr)
- (when lmc-store-flash
- (with-silent-modifications
- (put-text-property (match-beginning 1) (point)
- 'face 'region))
- (sit-for 0.2))
- (replace-match (format " %03d" word) t t nil 1)
- (when lmc-store-flash
- (sit-for 0.1)
- (with-silent-modifications
- (put-text-property (match-beginning 1) (point)
- 'face 'region))
- (sit-for 0.1)
- (with-silent-modifications
- (put-text-property (match-beginning 1) (point)
- 'face nil))
- (sit-for 0.1)))))
+ (let ((mb1 (match-beginning 1)))
+ (when lmc-store-flash
+ (lmc--with-silent-modifications
+ (put-text-property mb1 (point) 'face 'region))
+ (lmc--sit-for 0.2))
+ (let ((me1 (point)))
+ (insert (format " %03d" word)) (delete-region mb1 me1))
+ (when lmc-store-flash
+ (lmc--sit-for 0.1)
+ (lmc--with-silent-modifications
+ (put-text-property mb1 (point) 'face 'region))
+ (lmc--sit-for 0.1)
+ (lmc--with-silent-modifications
+ (put-text-property mb1 (point) 'face nil))
+ (lmc--sit-for 0.1))))))
(defun lmc-step ()
"Execute one LMC instruction."
"Run the code until hitting a HLT.
The machine will also stop if the user presses a key."
(interactive)
- (while (not (or (input-pending-p) (lmc-stopped-p)))
+ (while (not (or (unless lmc-turbo (input-pending-p)) (lmc-stopped-p)))
(lmc-step)
- (sit-for 0.05)))
+ (lmc--sit-for 0.05)))
;;; The LMC assembly language editor.