;; BU 6502 Project ; Obtained a copy of the micro chess source from ; http://www.dwheeler.com/6502/ ; See figforth_apple2 for copy of the original files ; APPLE II FIG-FORTH, V1.0 .import __CONMEM__ .segment "INIT" _nmi_int: BRK ; NMI vector _irq_int: BRK ; IRQ/BRK vector .segment "STARTUP" .define EQU = SSIZE EQU $100 ; sector size in bytes NBUF EQU 4 ; number of buffers desired in RAM ; (SSIZE*NBUF >EQU 1024 bytes) SECTR EQU $230 ; sector per drive ; forcing high drive to zero SECTL EQU $460 ; sector limit for two drives ; of 800 per drive. BMAG EQU $410 ; total buffer magnitude, in bytes ; expressed by SSIZE+4*NBUF ; BOS EQU $60 ; bottom of data stack, in zero-page. TOS EQU $CE ; top of data stack, in zero-page. N EQU $D6 ; scratch workspace. IP EQU $DE ; interpretive pointer. W EQU $E1 ; code field pointer. UP EQU $E3 ; user area pointer. XSAVE EQU $E5 ; temporary for X register. ; TIBX EQU $0100 ; terminal input buffer of 84 bytes. ORIG EQU $6100 ; origin of FORTH"s Dictionary. MEM EQU $9600 ; top of assigned memory+1 byte. UAREA EQU $9580 ; 128 bytes of user area DAREA EQU $9170 ; disk buffer space. ; ; Monitor calls for terminal support ; ; BU 6502 Implements these in support routines below ;OUTCH EQU $FDED ; output one ASCII char. to term. ;INCH EQU $FD0C ; input one ASCII char. to term. ;TCR EQU $FD8E ; terminal return and line feed. ; ;TOP EQU $7939 TOP EQU $7939 - 19 + CS2DDEND-CS2DDSTART + C2DDEND-C2DDSTART + FIBLOOPEND-FIBLOOPSTART + FIBEND-FIBSTART + FIBTBLEND-FIBTBLSTART ; BU HACK TO ADD ; ; Boot up parameters. This area provides jump vectors ; to Boot up code, and parameters describing the system. ; ; User cold entry point ENTER: NOP ; Vector to COLD entry JMP COLD+2 ; REENTR: NOP ; User Warm entry point JMP WARM ; Vector to WARM entry .WORD $0004 ; 6502 in radix-36 .WORD $5ED2 ; .WORD NTOP ; Name address of MON .WORD $0008 ; Apple Backspace Character .WORD UAREA ; Initial User Area .WORD TOS ; Initial Top of Stack .WORD $1FF ; Initial Top of Return Stack .WORD TIBX ; Initial terminal input buffer ; ; .WORD 31 ; Initial name field width .WORD 0 ; 0=nod disk, 1=disk .WORD TOP ; Initial fence address .WORD TOP ; Initial top of dictionary .WORD VL0 ; Initial Vocabulary link ptr. ; ; The following offset adjusts all code fields to avoid an ; address ending $XXFF. This must be checked and altered on ; any alteration , for the indirect jump at W-1 to operate ! ; ; .ORIGIN *+2 ; .BYTE $EA, $EA ; Couple of NOPs .INCLUDE "fib-fig.s" ; ; FIB ; FIBSTART: .BYTE $83, "FI",$C2 .WORD FIBLOOPSTART ; ( link to FIBLOOP ) FIB: .WORD DOCOL .WORD LIT,4,STAR .WORD FIBTBL,PLUS .WORD DUP .WORD AT .WORD SWAP .WORD TWO,PLUS .WORD AT .WORD SEMIS FIBEND: ; ; FIBTBL ; FIBTBLSTART: .BYTE $86,"FIBTB",$CC .WORD FIBSTART ; ( link to FIB ) FIBTBL: .WORD DOVAR .WORD $0000, $0000 ; fib 0 -> 0 .WORD $0001, $0000 ; fib 1 -> 1 .WORD $0001, $0000 ; fib 2 -> 1 .WORD $0002, $0000 ; fib 3 -> 2 .WORD $0003, $0000 ; fib 4 -> 3 .WORD $0005, $0000 ; fib 5 -> 5 .WORD $0008, $0000 ; fib 6 -> 8 .WORD $000d, $0000 ; fib 7 -> 13 .WORD $0015, $0000 ; fib 8 -> 21 .WORD $0022, $0000 ; fib 9 -> 34 .WORD $0037, $0000 ; fib 10 -> 55 .WORD $0059, $0000 ; fib 11 -> 89 .WORD $0090, $0000 ; fib 12 -> 144 .WORD $00e9, $0000 ; fib 13 -> 233 .WORD $0179, $0000 ; fib 14 -> 377 .WORD $0262, $0000 ; fib 15 -> 610 .WORD $03db, $0000 ; fib 16 -> 987 .WORD $063d, $0000 ; fib 17 -> 1597 .WORD $0a18, $0000 ; fib 18 -> 2584 .WORD $1055, $0000 ; fib 19 -> 4181 .WORD $1a6d, $0000 ; fib 20 -> 6765 .WORD $2ac2, $0000 ; fib 21 -> 10946 .WORD $452f, $0000 ; fib 22 -> 17711 .WORD $6ff1, $0000 ; fib 23 -> 28657 .WORD $b520, $0000 ; fib 24 -> 46368 .WORD $2511, $0001 ; fib 25 -> 75025 .WORD $da31, $0001 ; fib 26 -> 121393 .WORD $ff42, $0002 ; fib 27 -> 196418 .WORD $d973, $0004 ; fib 28 -> 317811 .WORD $d8b5, $0007 ; fib 29 -> 514229 .WORD $b228, $000c ; fib 30 -> 832040 .WORD $8add, $0014 ; fib 31 -> 1346269 .WORD $3d05, $0021 ; fib 32 -> 2178309 .WORD $c7e2, $0035 ; fib 33 -> 3524578 .WORD $04e7, $0057 ; fib 34 -> 5702887 .WORD $ccc9, $008c ; fib 35 -> 9227465 .WORD $d1b0, $00e3 ; fib 36 -> 14930352 .WORD $9e79, $0170 ; fib 37 -> 24157817 .WORD $7029, $0254 ; fib 38 -> 39088169 .WORD $0ea2, $03c5 ; fib 39 -> 63245986 .WORD $7ecb, $0619 ; fib 40 -> 102334155 .WORD $8d6d, $09de ; fib 41 -> 165580141 .WORD $0c38, $0ff8 ; fib 42 -> 267914296 .WORD $99a5, $19d6 ; fib 43 -> 433494437 .WORD $a5dd, $29ce ; fib 44 -> 701408733 .WORD $3f82, $43a5 ; fib 45 -> 1134903170 .WORD $e55f, $6d73 ; fib 46 -> 1836311903 .WORD $24e1, $b119 ; fib 47 -> 2971215073 ; 48 values occuping 192 bytes FIBTBLEND: ; ; MON ; SCREEN 79 LINE 3 ; NTOP: .BYTE $83,"MO",$CE .WORD FIBTBLSTART ; ( link to FIBTBL ) MON: .WORD *+2 STX XSAVE BRK ; break to monitor which is assumed LDX XSAVE ; to save this as reentry point JMP NEXT ; .segment "SUPPORT" XBLANK: LDA #$20 JMP OUTCH CRLF: JMP TCR ; print a carriage return and line feed. ; print accum as two hex digits HEX2: PHA LSR A LSR A LSR A LSR A JSR HEX2A PLA HEX2A: AND #$0F JSR HXDGT JMP OUTCH ; ;convert hex digit to ASCII ; HXDGT: CMP #$0A BCC HXDGT1 CLC ADC #7 HXDGT1: ADC #'0' RTS ONEKEY: JMP INCH ; ; print accum as one ASCII character ; LETTER: AND #$7F CMP #$20 ;compare ASCII space BCS LETTER1 ;good if >= ' ' LDA #'.' LETTER1: JMP OUTCH TCR: ;; LDA #$0D ; terminal return and line feed. ;; STA __CONMEM__ LDA #$0A STA __CONMEM__ LDA #$00 RTS OUTCH: CMP #$00 BEQ OUTCH1 STA __CONMEM__ ; output one ASCII char. to term. OUTCH1: LDA #$00 RTS INCH: LDA __CONMEM__ ; input one ASCII char. to term. RTS .segment "VECTORS" .addr _nmi_int ; NMI vector .addr ENTER ; Reset vector .addr _irq_int ; IRQ/BRK vector