;; 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 + ARG0END-ARG0START + S0END-S0START + PICKEND-PICKSTART + SIMPLOOPEND-SIMPLOOPSTART + SIMPWORKEND-SIMPWORKSTART + TWODROPEND-TWODROPSTART ; 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 "simple-fig.s"

;
;                                       SIMPWORK
; dL,dH --
;
SIMPWORKSTART:
          .BYTE $88, "SIMPWOR",$CB
          .WORD SIMPLOOPSTART	; ( link to SIMPLOOP )
SIMPWORK: .WORD DOCOL
	  .WORD TWODROP		; dL,dH --
	  .WORD ARG0,ZERO	;  -- n 0
	  .WORD PDO		; n 0 --
	  .WORD PLOOP,$FFFE
          .WORD SEMIS
SIMPWORKEND:
;
;                                       2DROP
; Drop a doubleword from the stack
;         
TWODROPSTART:	
	  .BYTE $85,"2DRO",$D0
          .WORD SIMPWORKSTART	; ( link to SIMPWORK )
TWODROP:  .WORD DOCOL
          .WORD DROP,DROP
          .WORD SEMIS
TWODROPEND:
;
;                                       MON
;                                       SCREEN 79 LINE 3
;
NTOP:     .BYTE $83,"MO",$CE
          .WORD TWODROPSTART	; ( link to 2DROP )
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