diff options
| -rw-r--r-- | 6502.lisp | 310 | ||||
| -rw-r--r-- | main.lisp | 82 | ||||
| -rw-r--r-- | notes.lisp | 24 | ||||
| -rw-r--r-- | wozmon.s | 160 |
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 |