-;;; lmc.el --- Little Man Computer in Elisp
+;;; lmc.el --- Little Man Computer in Elisp -*- lexical-binding:t -*-
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2013, 2014 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
-;; Version: 1.0
+;; Version: 1.3
;; 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
(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))
(let ((word (car word))
(label (nth 1 word))
(code (nth 2 word)))
- (let ((basepos (point))
- (base (current-column)))
+ (let () ;; ((basepos (point)) (base (current-column)))
(if (and label (symbolp label))
(insert (symbol-name label)))
;; (when (>= (current-column) (+ base tab-width))
(2 (lmc-font-lock-label)))
(".$" (0 (lmc-font-lock-opcode)))))
-(defun lmc-after-change (beg end len)
+(defun lmc-after-change (beg end _len)
(unless inhibit-read-only
(save-excursion
;; Replace any TAB or NL inserted, which could interfere with parsing.
(make-variable-buffer-local 'lmc-pc)
(defvar lmc-acc nil "LMC accumulator.")
(make-variable-buffer-local 'lmc-acc)
-(defvar lmc-output nil "Past LMC output,")
+(defvar lmc-output nil "Past LMC output.")
(make-variable-buffer-local 'lmc-output)
(defvar lmc--stopped nil "State where we stopped.")
(defun lmc-tool-bar-to-string (&optional map)
(let ((res ""))
(map-keymap
- (lambda (k v)
+ (lambda (_k v)
(when (eq (car v) 'menu-item)
(let* ((label (nth 1 v))
(cmd (nth 2 v))
"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
- (lmc--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)
- (lmc--with-silent-modifications
- (put-text-property (match-beginning 1) (point)
- 'face 'region))
- (sit-for 0.1)
- (lmc--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."
(setq lmc--stopped (lmc--state))
(force-mode-line-update)
(message "Done.")))
- (IN (setq lmc-acc (mod (read-number "Enter a number") 1000))
+ (IN (setq lmc-acc (mod (read-number "Enter a number: ") 1000))
(incf lmc-pc))
(OUT (message "Output: %03d" lmc-acc)
(push (format "%03d" lmc-acc) lmc-output)
"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.
(cond
((> (nth 0 (syntax-ppss)) 0) nil)
((looking-at "(") tab-width)
- ((not (looking-at comment-start-skip)) 0)
+ ((not (looking-at comment-start-skip))
+ (if (looking-at "[ \t]*$") tab-width 0))
((not (looking-at "\\s<\\s<")) nil)
((save-excursion (forward-comment (- (point))) (bobp)) 0)
(t (forward-comment (point-max)) (lmc-asm-indentation)))))