Initial commit

4 files changed, 576 insertions, 0 deletions

diff --git a/6502.lisp b/6502.lisp
new file mode 100644
index 0000000..23696ac
--- /dev/null
+++ b/6502.lisp
@@ -0,0 +1,310 @@
+;; -*- mode: common-lisp -*-
+
+;; Every instruction, its decimal opcode, and the
+;; usable addressing modes.
+(setf
+ *instructions*
+ ;; Load & Store
+ '((LDA 169 (immediate
+			 absolute
+			 zero-page
+			 absolute-indexed-x
+			 absolute-indexed-y
+			 zero-page-indexed-x
+			 indexed-indirect
+			 indirect-indexed))
+   (LDX 162 (immediate
+			 zero-page
+			 zero-page-indexed-y
+			 absolute
+			 absolute-indexed-y))
+   (LDY 160 (immediate
+			 zero-page
+			 zero-page-indexed-x
+			 absolute
+			 absolute-indexed-x))
+   (STA 137 (absolute
+			 zero-page
+			 absolute-indexed-x
+			 absolute-indexed-y
+			 zero-page-indexed-x
+			 indexed-indirect
+			 indirect-indexed))
+   (STX 130 (zero-page
+			 zero-page-indexed-y
+			 absolute))
+   (STY 128 (zero-page
+			 zero-page-indexed-x
+			 absolute))
+   ;;Arithmetic
+   (ADC 105 (immediate
+			 absolute
+			 zero-page
+			 absolute-indexed-x
+			 absolute-indexed-y
+			 zero-page-indexed-x
+			 indexed-indirect
+			 indirect-indexed))
+   (SBC 233 (immediate
+			 absolute
+			 zero-page
+			 absolute-indexed-x
+			 absolute-indexed-y
+			 zero-page-indexed-x
+			 indexed-indirect
+			 indirect-indexed))
+   ;;Increment & Decrement
+   (INC 226 (zero-page
+			 zero-page-indexed-x
+			 absolute
+			 absolute-indexed-x))
+   (INX 232 (implied))
+   (INY 200 (implied))
+   (DEC 194 (zero-page
+			 zero-page-indexed-x
+			 absolute
+			 absolute-indexed-x))
+   (DEX 202 (implied))
+   (DEY 136 (implied))
+   ;; Logical
+   (AND  41 (immediate
+			 absolute
+			 zero-page
+			 absolute-indexed-x
+			 absolute-indexed-y
+			 zero-page-indexed-x
+			 indexed-indirect
+			 indirect-indexed))
+   (ORA   9 (immediate
+			 absolute
+			 zero-page
+			 absolute-indexed-x
+			 absolute-indexed-y
+			 zero-page-indexed-x
+			 indexed-indirect
+			 indirect-indexed))
+   (EOR  73 (immediate
+			 absolute
+			 zero-page
+			 absolute-indexed-x
+			 absolute-indexed-y
+			 zero-page-indexed-x
+			 indexed-indirect
+			 indirect-indexed))
+   ;; Jump, Branch, Compare
+   (JMP  72 (absolute
+			 indirect-absolute))
+   (BCC 144 (relative))
+   (BCS 176 (relative))
+   (BEQ 240 (relative))
+   (BNE 208 (relative))
+   (BMI  48 (relative))
+   (BPL  16 (relative))
+   (BVS 112 (relative))
+   (BVC  80 (relative))
+   (CMP 201 (immediate
+			 absolute
+			 zero-page
+			 absolute-indexed-x
+			 absolute-indexed-y
+			 zero-page-indexed-x
+			 indexed-indirect
+			 indirect-indexed))
+   (CPX 224 (immediate
+			 zero-page
+			 absolute))
+   (CPY 192 (immediate
+			 zero-page
+			 absolute))
+   (BIT  32 (zero-page
+			 absolute))
+   ;; Shift & Rotate
+   (ASL  10 (accumulator
+			 zero-page
+			 zero-page-indexed-x
+			 absolute
+			 absolute-indexed-x))
+   (LSR  74 (accumulator
+			 zero-page
+			 zero-page-indexed-x
+			 absolute
+			 absolute-indexed-x))
+   (ROL  42 (accumulator
+			 zero-page
+			 zero-page-indexed-x
+			 absolute
+			 absolute-indexed-x))
+   (ROR 106 (accumulator
+			 zero-page
+			 zero-page-indexed-x
+			 absolute
+			 absolute-indexed-x))
+   ;; Transfer
+   (TAX 170 (implied))
+   (TAY 168 (implied))
+   (TXA 138 (implied))
+   (TYA 152 (implied))
+   ;; Stack
+   (TSX 186 (implied))
+   (TXS 154 (implied))
+   (PHA  72 (implied))
+   (PHP   8 (implied))
+   (PLA 104 (implied))
+   (PLP  40 (implied))
+   ;; Subroutine
+   (JSR  32 (implied))
+   (RTI  64 (implied))
+   (RTS  96 (implied))
+   ;; Set & Reset
+   (CLC  24 (implied))
+   (CLD 216 (implied))
+   (CLI  88 (implied))
+   (CLV 184 (implied))
+   (SEC  56 (implied))
+   (SED 248 (implied))
+   (SEI 120 (implied))
+   ;; Other
+   (NOP 234 (implied))
+   (BRK   0 (implied))))
+
+;; Predicate: is a combination of instruction
+;; and addressing mode correct?
+(defun valid-instruction? (instruction addressing-mode)
+  (dolist (x *instructions* nil)
+	(when
+		(and
+		 (equal (car x) instruction)
+		 (member addressing-mode (caddr x)))
+	  (return T))))
+
+;; Is string hexadecimal?
+(defun hexd? (string)
+  (let ((stack ()))
+	(dotimes (i (length string))
+	  (push
+	   (or (and (char-not-lessp
+				 (char string i) #\0)
+				(char-not-greaterp
+				 (char string i) #\9))
+		   (and (char-not-lessp
+				 (char string i) #\A)
+				(char-not-greaterp
+				 (char string i) #\F)))
+	   stack))
+	(push 'and stack)
+	(eval stack)))
+
+;; Convert an arbitrarily sized hexadecimal number as
+;; string, to a positive decimal integer.
+(defun hex2dec (string)
+  (flet ((hex (c)
+		   (cond
+			 ((and (char-not-lessp c #\0)
+				   (char-not-greaterp c #\9))
+			  (- (char-code c)
+				 (char-code #\0)))
+			 ((and (char-not-lessp c #\A)
+				   (char-not-greaterp c #\F))
+			  (+ (- (char-code (char-downcase c))
+					(char-code #\a))
+				 10)))))
+	(let ((ret 0))
+	  (do ((i 0 (incf i))
+		   (j (- (length string) 1) (decf j)))
+		  ((minusp j) ())
+		(setf ret
+			  (+ ret
+				 (* (expt 16 j)
+					(hex (char string i))))))
+	  ret)))
+
+;;(define-compiler-macro (list)
+;; A list with with the respective rules of some
+;; addressing mode syntax.
+;; ... ... ... could definitely macro most of them.
+(setf
+ *addressing-modes-syntax*
+ '((immediate ; #?? ... more complex syntax rules for later
+	(lambda (s)
+	  (eq "#" (subseq s 0 1))))
+   (absolute ;"$????"
+	(lambda (s)
+	  (and
+	   (equal (length s) 5)
+	   (equal "$" (subseq s 0 1))
+	   (hexd? (subseq s 1 5)))))
+   (zero-page ;"$??"
+	(lambda (s)
+	  (and
+	   (equal (length s) 3)
+	   (equal "$" (subseq s 0 1))
+	   (hexd? (subseq s 1 3)))))
+   (implied nil)
+   (indirect-absolute ;($????)
+	(lambda (s)
+	  (and
+	   (equal (length s) 7)
+	   (equal "($" (subseq s 0 2))
+	   (hexd? (subseq s 1 5))
+	   (equal ")" (subseq s 5 6)))))
+   (absolute-indexed-x ;"$????,X"
+	(lambda (s)
+	  (and
+	   (equal (length s) 7)
+	   (equal "$" (subseq s 0 1))
+	   (hexd? (subseq s 1 5))
+	   (equal ",X" (subseq s 5 7)))))
+   (absolute-indexed-y ;"$????,Y"
+	(lambda (s)
+	  (and
+	   (equal (length s) 7)
+	   (equal "$" (subseq s 0 1))
+	   (hexd? (subseq s 1 5))
+	   (equal ",Y" (subseq s 5 7)))))
+   (zero-page-indexed-x ;"$??,X"
+	(lambda (s)
+	  (and
+	   (equal (length s) 5)
+	   (equal (subseq s 0 1) "$")
+	   (hexd? (subseq s 1 3))
+	   (equal (subseq s 3 5) ",X"))))
+   (zero-page-indexed-y ;"$??,Y"
+	(lambda (s)
+	  (and
+	   (equal (length s) 5)
+	   (equal (subseq s 0 1) "$")
+	   (hexd? (subseq s 1 3))
+	   (equal (subseq s 3 5) ",Y"))))
+   (indexed-indirect ;"($??,X)"
+	(lambda (s)
+	  (and
+	   (equal (length s) 7)
+	   (equal (subseq s 0 2) "($")
+	   (hexd? (subseq s 2 4))
+	   (equal (subseq s 4 7) ",X)"))))
+   (indirect-indexed ;"($??),Y"
+	(lambda (s)
+	  (and
+	   (equal (length s) 7)
+	   (equal (subseq s 0 2) "($")
+	   (hexd? (subseq s 2 4))
+	   (equal (subseq s 4 7) "),Y"))))
+   ;;How to fix that relative and absolute are the same rule?
+   ;;A check upstream would suffice.
+   (relative ;"$????"
+	(lambda (s)
+	  (and
+	   (equal (length s) 5)
+	   (equal (subseq s 0 1) "$")
+	   (hexd? (subseq s 1 5)))))
+   (accumulator ;"A"
+	(lambda (s)
+	  (and
+	   (equal (length s) 1)
+	   (equal "A" (subseq s 0 1)))))))
+
+;; EXAMPLE
+;; Evaluate the second syntax rule on a string
+(funcall
+ (eval (cadar (cdr *addressing-modes-syntax*)))
+ "$A6AF")
diff --git a/main.lisp b/main.lisp
new file mode 100644
index 0000000..e4dd9c4
--- /dev/null
+++ b/main.lisp
@@ -0,0 +1,82 @@
+;; -*- mode: common-lisp -*-
+
+(setf
+ *source-file*
+ (open  "/home/aleksei/lisp/wozmon.s"))
+
+(setf
+ *source-line-number*
+ 0)
+
+(defun interpret-character (s x)
+  "Interpret meanings of characters."
+  (cond
+	((>= x (length s))
+	 'end-of-line)
+	(t
+	 ;; Have character, interpret
+	 (let ((c (char s x)))
+	   (cond
+		 ((eq c #\;) ; Comment
+		  'comment)
+		 ((eq c #\ ) ; Space
+		  'whitespace)
+		 (t
+		  'normal))))))
+
+(defun extract-word (line-string index)
+  "Extract a single word from line-string, starting at index."
+  (cond
+	((member (interpret-character line-string index)
+			 `(end-of-line comment))
+	 'end-of-line)
+	((equal (interpret-character line-string index)
+			'whitespace)
+	 'whitespace)
+	(t
+	 (subseq
+	  line-string
+	  index
+	  (do ((end index (incf end)))
+		  ((not (equal 'normal
+					   (interpret-character line-string end)))
+		   end))))))
+
+(defun extract-words (line-string &optional (index 0))
+  "Return a list the constituent word strings of line-string."
+  ;; Word Processing Logic
+  (let ((word (extract-word line-string index)))
+	(cond
+	  ;; Terminate execution at end-of-line.
+	  ((equal word 'end-of-line)
+	   nil)
+	  ;; If empty, continue on.
+	  ((equal word 'whitespace)
+	   (extract-words line-string (+ index 1)))
+	  ;; Otherwise, extract word and move ahead.
+	  (t
+	   (cons word
+			 (extract-words line-string
+							(+ index
+							   (length word))))))))
+
+
+
+
+(defun last-char (s)
+  (char s (- (length s) 1)))
+
+(defun label? (s)
+  (eq (last-char s) #\:))
+
+
+(setf
+ *grammar*
+ (('label
+   (lambda (l)
+	 ))))
+
+(defun read_code ()
+  (incf *source-line-number*)
+  ()
+  )
diff --git a/notes.lisp b/notes.lisp
new file mode 100644
index 0000000..5ea7ef4
--- /dev/null
+++ b/notes.lisp
@@ -0,0 +1,24 @@
+;;;;; -*- mode: common-lisp -*-
+
+;; Addressing Mode Symbols 
+'(immediate
+  absolute 
+  zero-page 
+  implied 
+  indirect-absolute 
+  absolute-indexed-x 
+  absolute-indexed-y 
+  zero-page-indexed-x 
+  zero-page-indexed-y 
+  indexed-indirect 
+  indirect-indexed 
+  relative 
+  accumulator)
+
+;; Applying a syntax rule defined
+;; in *addressing-modes-syntax*
+(funcall
+ (eval
+  (cadar
+   *addressing-modes-syntax*))
+ "arg")
diff --git a/wozmon.s b/wozmon.s
new file mode 100644
index 0000000..b26561e
--- /dev/null
+++ b/wozmon.s
@@ -0,0 +1,160 @@
+;  The WOZ Monitor for the Apple 1
+;  Written by Steve Wozniak in 1976
+
+
+; Page 0 Variables
+
+XAML            = $24           ;  Last "opened" location Low
+XAMH            = $25           ;  Last "opened" location High
+STL             = $26           ;  Store address Low
+STH             = $27           ;  Store address High
+L               = $28           ;  Hex value parsing Low
+H               = $29           ;  Hex value parsing High
+YSAV            = $2A           ;  Used to see if hex value is given
+MODE            = $2B           ;  $00=XAM, $7F=STOR, $AE=BLOCK XAM
+
+
+; Other Variables
+
+IN              = $0200         ;  Input buffer to $027F
+KBD             = $D010         ;  PIA.A keyboard input
+KBDCR           = $D011         ;  PIA.A keyboard control register
+DSP             = $D012         ;  PIA.B display output register
+DSPCR           = $D013         ;  PIA.B display control register
+
+               .org $FF00
+               .export RESET
+
+RESET:          CLD             ; Clear decimal arithmetic mode.
+                CLI
+                LDY #$7F        ; Mask for DSP data direction register.
+                STY DSP         ; Set it up.
+                LDA #$A7        ; KBD and DSP control register mask.
+                STA KBDCR       ; Enable interrupts, set CA1, CB1, for
+                STA DSPCR       ;  positive edge sense/output mode.
+NOTCR:          CMP #'_'+$80    ; "_"?
+                BEQ BACKSPACE   ; Yes.
+                CMP #$9B        ; ESC?
+                BEQ ESCAPE      ; Yes.
+                INY             ; Advance text index.
+                BPL NEXTCHAR    ; Auto ESC if > 127.
+ESCAPE:         LDA #'\'+$80    ; "\".
+                JSR ECHO        ; Output it.
+GETLINE:        LDA #$8D        ; CR.
+                JSR ECHO        ; Output it.
+                LDY #$01        ; Initialize text index.
+BACKSPACE:      DEY             ; Back up text index.
+                BMI GETLINE     ; Beyond start of line, reinitialize.
+NEXTCHAR:       LDA KBDCR       ; Key ready?
+                BPL NEXTCHAR    ; Loop until ready.
+                LDA KBD         ; Load character. B7 should be ‘1’.
+                STA IN,Y        ; Add to text buffer.
+                JSR ECHO        ; Display character.
+                CMP #$8D        ; CR?
+                BNE NOTCR       ; No.
+                LDY #$FF        ; Reset text index.
+                LDA #$00        ; For XAM mode.
+                TAX             ; 0->X.
+SETSTOR:        ASL             ; Leaves $7B if setting STOR mode.
+SETMODE:        STA MODE        ; $00=XAM, $7B=STOR, $AE=BLOCK XAM.
+BLSKIP:         INY             ; Advance text index.
+NEXTITEM:       LDA IN,Y        ; Get character.
+                CMP #$8D        ; CR?
+                BEQ GETLINE     ; Yes, done this line.
+                CMP #'.'+$80    ; "."?
+                BCC BLSKIP      ; Skip delimiter.
+                BEQ SETMODE     ; Set BLOCK XAM mode.
+                CMP #':'+$80    ; ":"?
+                BEQ SETSTOR     ; Yes. Set STOR mode.
+                CMP #'R'+$80    ; "R"?
+                BEQ RUN         ; Yes. Run user program.
+                STX L           ; $00->L.
+                STX H           ;  and H.
+                STY YSAV        ; Save Y for comparison.
+NEXTHEX:        LDA IN,Y        ; Get character for hex test.
+                EOR #$B0        ; Map digits to $0-9.
+                CMP #$0A        ; Digit?
+                BCC DIG         ; Yes.
+                ADC #$88        ; Map letter "A"-"F" to $FA-FF.
+                CMP #$FA        ; Hex letter?
+                BCC NOTHEX      ; No, character not hex.
+DIG:            ASL
+                ASL             ; Hex digit to MSD of A.
+                ASL
+                ASL
+                LDX #$04        ; Shift count.
+HEXSHIFT:       ASL             ; Hex digit left, MSB to carry.
+                ROL L           ; Rotate into LSD.
+                ROL H           ; Rotate into MSD’s.
+                DEX             ; Done 4 shifts?
+                BNE HEXSHIFT    ; No, loop.
+                INY             ; Advance text index.
+                BNE NEXTHEX     ; Always taken. Check next character for hex.
+NOTHEX:         CPY YSAV        ; Check if L, H empty (no hex digits).
+                BEQ ESCAPE      ; Yes, generate ESC sequence.
+                BIT MODE        ; Test MODE byte.
+                BVC NOTSTOR     ; B6=0 STOR, 1 for XAM and BLOCK XAM
+                LDA L           ; LSD’s of hex data.
+                STA (STL,X)     ; Store at current ‘store index’.
+                INC STL         ; Increment store index.
+                BNE NEXTITEM    ; Get next item. (no carry).
+                INC STH         ; Add carry to ‘store index’ high order.
+TONEXTITEM:     JMP NEXTITEM    ; Get next command item.
+RUN:            JMP (XAML)      ; Run at current XAM index.
+NOTSTOR:        BMI XAMNEXT     ; B7=0 for XAM, 1 for BLOCK XAM.
+                LDX #$02        ; Byte count.
+SETADR:         LDA L-1,X       ; Copy hex data to
+                STA STL-1,X     ;  ‘store index’.
+                STA XAML-1,X    ; And to ‘XAM index’.
+                DEX             ; Next of 2 bytes.
+                BNE SETADR      ; Loop unless X=0.
+NXTPRNT:        BNE PRDATA      ; NE means no address to print.
+                LDA #$8D        ; CR.
+                JSR ECHO        ; Output it.
+                LDA XAMH        ; ‘Examine index’ high-order byte.
+                JSR PRBYTE      ; Output it in hex format.
+                LDA XAML        ; Low-order ‘examine index’ byte.
+                JSR PRBYTE      ; Output it in hex format.
+                LDA #':'+$80    ; ":".
+                JSR ECHO        ; Output it.
+PRDATA:         LDA #$A0        ; Blank.
+                JSR ECHO        ; Output it.
+                LDA (XAML,X)    ; Get data byte at ‘examine index’.
+                JSR PRBYTE      ; Output it in hex format.
+XAMNEXT:        STX MODE        ; 0->MODE (XAM mode).
+                LDA XAML
+                CMP L           ; Compare ‘examine index’ to hex data.
+                LDA XAMH
+                SBC H
+                BCS TONEXTITEM  ; Not less, so no more data to output.
+                INC XAML
+                BNE MOD8CHK     ; Increment ‘examine index’.
+                INC XAMH
+MOD8CHK:        LDA XAML        ; Check low-order ‘examine index’ byte
+                AND #$07        ;  For MOD 8=0
+                BPL NXTPRNT     ; Always taken.
+PRBYTE:         PHA             ; Save A for LSD.
+                LSR
+                LSR
+                LSR             ; MSD to LSD position.
+                LSR
+                JSR PRHEX       ; Output hex digit.
+                PLA             ; Restore A.
+PRHEX:          AND #$0F        ; Mask LSD for hex print.
+                ORA #'0'+$80    ; Add "0".
+                CMP #$BA        ; Digit?
+                BCC ECHO        ; Yes, output it.
+                ADC #$06        ; Add offset for letter.
+ECHO:           BIT DSP         ; DA bit (B7) cleared yet?
+                BMI ECHO        ; No, wait for display.
+                STA DSP         ; Output character. Sets DA.
+                RTS             ; Return.
+
+                BRK             ; unused
+                BRK             ; unused
+
+; Interrupt Vectors
+
+                .WORD $0F00     ; NMI
+                .WORD RESET     ; RESET
+                .WORD $0000     ; BRK/IRQ