X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=ez.git;a=blobdiff_plain;f=ez.el;h=2fa15b717a50758a9257d5aeef3892c6e9cfbcad;hp=d33f857f987320a736f5dabee72d7fa941b3caba;hb=0bd73fc1b7524bf64d416f5d311e9775a8afb913;hpb=d6715a8988d1e6907c26be18fc866fe03a92a252 diff --git a/ez.el b/ez.el index d33f857..2fa15b7 100644 --- a/ez.el +++ b/ez.el @@ -196,6 +196,25 @@ (t (ez-mem-set-word (+ prop-addr 1) value))))) +(defun ez-get-obj-attr (obj attr) + (let* ((byte-num (/ attr 8)) + (bit-num (mod attr 8)) + (bit-mask (lsh 1 (- 7 bit-num)))) + (if (> (logand bit-mask (ez-mem-ref-byte (+ (ez-get-obj-addr obj) byte-num))) 0) + 1 + 0))) + +(defun ez-set-obj-attr (obj attr val) + (let* ((byte-num (/ attr 8)) + (bit-num (mod attr 8)) + (bit-mask (lsh 1 (- 7 bit-num))) + (byte-addr (+ (ez-get-obj-addr obj) byte-num)) + (byte (ez-mem-ref-byte byte-addr)) + (current-set (> (logand bit-mask byte) 0))) + (if (or (and current-set (= val 0)) + (and (not current-set) (> val 0))) + (ez-mem-set-byte byte-addr (logxor byte bit-mask))))) + ;; Z-strings (defvar ez-zstring-alphabets @@ -378,7 +397,9 @@ operand-types '(w))) ((<= #xB0 opbyte #xBF) (setq optype '0op - opcode (- opbyte #xb0))) + opcode (- opbyte #xb0) + operands '() + operand-types '())) ((<= #xC0 opbyte #xDF) (error "Unsupported op %x" opbyte)) ((<= #xE0 opbyte #xFF) @@ -392,8 +413,8 @@ (error "Unsupported op PC:%x Optype:%s Opcode:%x Operands:%s Operand-types:%s" instr-pc optype opcode operands operand-types)) (let ((mnemonic (elt table-row 1))) - (message "PC:%x Optype:%s Opcode:%x Mnemonic:%s Operands:%s" - instr-pc optype opcode mnemonic operands)) + (message "PC:%x Optype:%s Opcode:%x Mnemonic:%s Operands:%s Operand-types:%s" + instr-pc optype opcode mnemonic operands operand-types)) (funcall (elt table-row 2) operands operand-types)))) (defun ez-read-var-operands-and-inc () @@ -413,8 +434,7 @@ (let ((type4 (logand #b11))) (if (= type4 #b11) nil - (list type4))))))))))))) - (operands nil)) + (list type4)))))))))))))) (cons (mapcar (lambda (type) @@ -466,6 +486,7 @@ ((2op #x0D) store ez-op-store) ((1op #x0E) load ez-op-load) ((var #x01) storew ez-op-storew) + ((2op #x0F) loadw ez-op-loadw) ((2op #x01) je ez-op-je) ((2op #x08) or ez-op-or) ((2op #x09) and ez-op-and) @@ -479,7 +500,8 @@ ((1op #x02) get_child ez-op-get-child) ((1op #x03) get_parent ez-op-get-parent) ((2op #x0A) test_attr ez-op-test-attr) - ((var #x03) put_prop ez-op-put-prop))) + ((var #x03) put_prop ez-op-put-prop) + ((0op #x02) print ez-op-print))) (defun ez-op-ret (operands &optional operand-types) (let ((retval (car operands))) @@ -528,6 +550,12 @@ (ez-mem-set-word (+ baddr (* 2 n)) a)) t) +(defun ez-op-loadw (operands operand-types) + (let ((baddr (car operands)) + (n (cadr operands))) + (ez-set-var (ez-read-pc-byte-and-inc) (ez-mem-ref-word (+ baddr (* 2 n))))) + t) + (defun ez-op-and (operands operand-types) (let ((a (car operands)) (b (cadr operands))) @@ -609,7 +637,12 @@ (ez-set-obj-prop obj prop a) t)) -;; Main +(defun ez-op-print (operands operand-types) + (ez-print (ez-get-zstring (ez-get-pc))) + t) + + +;; Execution loop (defun ez-run (filename) (ez-load-file filename) @@ -618,13 +651,86 @@ (while (ez-execute-instr))) -;; Scratch - -;; (ez-load-file "zork1.z3") -;; (ez-parse-header) -;; (setq ez-call-stack (list (ez-make-call-stack-frame ez-start-pc))) -;; (while (ez-execute-instr)) -(ez-run "zork1.z3") +;;; Buffer and I/O +;; + +(defun ez-render-prompt () + (with-current-buffer "*ez*" + (let ((update-point (= ez-input-marker (point))) + (update-window-points (mapcar (lambda (w) + (list (= (window-point w) ez-input-marker) + w)) + (get-buffer-window-list nil nil t)))) + (save-excursion + (set-marker-insertion-type ez-prompt-marker nil) + (set-marker-insertion-type ez-input-marker t) + (let ((inhibit-read-only t)) + (delete-region ez-prompt-marker ez-input-marker) + (goto-char ez-prompt-marker) + (insert + ">" + (propertize " " ; Need this to be separate to mark it as rear-nonsticky + 'read-only t + 'rear-nonsticky t))) + (set-marker-insertion-type ez-input-marker nil)) + (goto-char ez-input-marker)))) + +(defvar ez-prompt-marker nil + "Marker for prompt position in buffer.") + +(defvar ez-input-marker nil + "Marker for prompt position in buffer.") + +(defun ez-setup-buffer () + (with-current-buffer (get-buffer-create "*ez*") + (let ((inhibit-read-only t)) + (delete-region (point-min) (point-max))) + (setq-local scroll-conservatively 1) + (if (markerp ez-prompt-marker) + (set-marker ez-prompt-marker (point-max)) + (setq ez-prompt-marker (point-max-marker))) + (if (markerp ez-input-marker) + (set-marker ez-input-marker (point-max)) + (setq ez-input-marker (point-max-marker))) + (goto-char (point-max)) + (ez-render-prompt))) + + +(defun ez-print (string) + (with-current-buffer "*ez*" + (save-excursion + (goto-char ez-prompt-marker) + (insert-before-markers string)))) + +;; Mode + +(defvar ez-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'ez-enter) + map)) + +(define-derived-mode ez-mode text-mode "ez" + "Major mode for EZ.") + +(when (fboundp 'evil-set-initial-state) + (evil-set-initial-state 'ez-mode 'insert)) + +(defun ez (zfile) + (interactive "fEnter name of z3 story file: ") + (if (get-buffer "*ez*") + (switch-to-buffer "*ez*") + (switch-to-buffer "*ez*") + (ez-mode) + (ez-setup-buffer) + (ez-run zfile)) + "Started EZ.") + +(defun ez-debug () + (interactive) + (switch-to-buffer "*ez*") + (ez-mode) + (ez-setup-buffer) + (ez-run "zork1.z3")) ;;; ez.el ends here