;; 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 + TWODROPEND-TWODROPSTART + TWOOVEREND-TWOOVERSTART + TWOSWAPEND-TWOSWAPSTART + PICKEND-PICKSTART + S0END-S0START ; 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 DUP,ZBRAN
          .WORD 34     		; END input was zero 
          .WORD ZERO,ZERO,ROT
	  .WORD ONE,ZERO,ROT
          .WORD ZERO,PDO       	; DO
L3894:	  .WORD TWOOVER    
          .WORD DPLUS
          .WORD TWOSWAP    
          .WORD PLOOP,$FFF8   	; LOOP ( L3894 )
	  .WORD TWODROP
	  .WORD BRAN,4
	  .WORD ZERO
          .WORD SEMIS
FIBEND:
;
;                                       2DROP
; Drop a doubleword from the stack
;         
TWODROPSTART:	
	  .BYTE $85,"2DRO",$D0
          .WORD FIBSTART	; ( link to FIB )
TWODROP:  .WORD DOCOL
          .WORD DROP,DROP
          .WORD SEMIS
TWODROPEND:
;
;                                       2OVER
; Duplicate the second double word
; over the double word on the stack
;         
TWOOVERSTART:	
	 .BYTE $85,"2OVE",$D2
         .WORD TWODROPSTART	; ( link to 2DROP )
TWOOVER: .WORD DOCOL
         .WORD THREE,PICK
         .WORD THREE,PICK
         .WORD SEMIS
TWOOVEREND:	
;
;                                       2SWAP
; Swap two double words on the stack
;         
TWOSWAPSTART:	
	  .BYTE $85,"2SWA",$D0
          .WORD TWOOVERSTART	; ( link to 2OVER )
TWOSWAP:  .WORD DOCOL
          .WORD TWO,PICK,TOR
          .WORD THREE,PICK,TOR
          .WORD ZERO,PICK,TOR
          .WORD ONE,PICK,TOR
          .WORD TWODROP,TWODROP
          .WORD RFROM,RFROM,RFROM,RFROM
          .WORD SEMIS
TWOSWAPEND:
;
;                                       PICK
; Nondestructive peek on the data stack
;      
PICKSTART:	
	  .BYTE $84,"PIC",$CB
          .WORD TWOSWAPSTART	; ( link to 2SWAP )
PICK:     .WORD DOCOL
          .WORD DUP
          .WORD ZERO,LESS,ZBRAN
          .WORD 20		; L3834 input was negative
          .WORD TWO,STAR
          .WORD S0,TWO,PLUS
          .WORD PLUS
          .WORD AT
          .WORD BRAN,18		; END
L3834:	  .WORD ONE,PLUS
          .WORD TWO,STAR
          .WORD SPAT
          .WORD SWAP
          .WORD PLUS
          .WORD AT
	  .WORD SEMIS
PICKEND:
;
;                                       S0
; Address of the start of the data stack
;                                       
S0START:	
	  .BYTE $82,"S",$B0
          .WORD PICKSTART	; ( link to PICK )
S0:       .WORD DOCON
          .WORD TOS
S0END:
;
;                                       MON
;                                       SCREEN 79 LINE 3
;
NTOP:     .BYTE $83,"MO",$CE
          .WORD S0START		; ( link to S0 )
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