+;;; Instructions
+;;
+
+(define ((make-instr opcode modifier A-mode A-num B-mode B-num name) . args)
+ (match args
+ (('copy n) (make-instr opcode modifier A-mode A-num B-mode B-num n))
+ (('copy-from! other n)
+ (set! opcode (other 'opcode))
+ (set! modifier (other 'modifier))
+ (set! A-mode (other 'A-mode))
+ (set! A-num (other 'A-num))
+ (set! B-mode (other 'B-mode))
+ (set! B-num (other 'B-num))
+ (set! name n))
+ (('opcode) opcode)
+ (('modifier) modifier)
+ (('A-mode) A-mode)
+ (('A-num) A-num)
+ (('B-mode) B-mode)
+ (('B-num) B-num)
+ (('name) name)
+ (('print) (print opcode
+ "." modifier
+ " " (mode-string A-mode) A-num
+ ", " (mode-string B-mode) B-num
+ (if (null? name) "" (conc " ; " name))))
+ (('set-opcode! x n) (set! opcode x) (set! name n))
+ (('set-modifier! x n) (set! modifier x) (set! name n))
+ (('set-A-mode! x n) (set! A-mode x) (set! name n))
+ (('set-A-num! x n) (set! A-num x) (set! name n))
+ (('set-B-mode! x n) (set! B-mode x) (set! name n))
+ (('set-B-num! x n) (set! B-num x) (set! name n))))
+
+(define (mode-string mode)
+ (case mode
+ ((immediate) "#")
+ ((direct) "$")
+ ((indirect-A "*"))
+ ((indirect-B "@"))
+ ((pre-indirect-A "{"))
+ ((pre-indirect-B "<"))
+ ((post-indirect-A "}"))
+ ((post-indirect-B ">"))))
+
+(define initial-instruction
+ (make-instr 'DAT 'F 'immediate 0 'immediate 0 '()))
+
+
+;;; Memory setup and addressing