;
;  camel80o.s      optional words to add to CAMEL88 for the Z180
;
;  These words are not necessarily ANSI compliant!  They are words
;  I've used in the past and found useful, so I've mutated them
;  into the CAMEL80 environment.  If you choose to rewrite these
;  to be ANSI compliant, or if you replace them with their ANSI
;  equivalents (if any), please distribute them; I'd like a copy!
;  Karl Lunt   27 Jun 2000
;
;  I also added several words that are specific to the Alerton MicroView2
;  that I used as a development base.
;  Karl Lunt   8 July 2000
;


;
;  .R       n len --			print n in field len long
;
		head	DOTR,2,".r",docolon
		DW     	TOR,STOD,RFROM,DDOTR
        DW     	EXIT

;
;  D.R		dword nlen -- 		print dword in field nlen long
;
		head	DDOTR,3,"d.r",docolon
		DW     	TOR,SWOP,OVER,DABS,LESSNUM,NUMS,SIGN
        DW     	NUMGREATER,RFROM,OVER,MINUS,SPACES,TYPE
        DW     	EXIT

;
;  DUMP		naddr nknt -- 		display nknt bytes of memory from naddr
;
    	head 	DUMP,4,"dump",docolon
		DW      HEX,CR,LIT,5,SPACES
        DW      LIT,16,LIT,0,XDO
DUMP1   DW      II,LIT,3,DOTR
        DW      XLOOP,DUMP1
        DW      LIT,2,SPACES,LIT,16,LIT,0,XDO
DUMP2   DW      II,LIT,0,LESSNUM,NUM,NUMGREATER,TYPE
        DW      XLOOP,DUMP2
        DW      OVER,PLUS,SWOP,DUP,LIT,0fh
        DW      AND,XOR,XDO
DUMP3   DW      CR,II,LIT,0,LIT,4,DDOTR,LIT,1
        DW      SPACES,II,LIT,16,PLUS,II
        DW      OVER,OVER,XDO
DUMP4   DW      II,CFETCH,SPACE,LIT,0,LESSNUM,NUM,NUM
        DW      NUMGREATER,TYPE
        DW      XLOOP,DUMP4
        DW      LIT,2,SPACES,XDO
DUMP5   DW      II,CFETCH,DUP,LIT,32,LESS
        DW      QBRANCH,DUMP6
        DW      DROP,LIT,46
DUMP6   DW      DUP,LIT,126,GREATER
        DW      QBRANCH,DUMP7
        DW      DROP,LIT,46
DUMP7   DW      EMIT
        DW      XLOOP,DUMP5
        DW      LIT,16
        DW      XPLUSLOOP,DUMP3
        DW      CR,EXIT


;
;  DELAYMS      n -- 				delay n milliseconds (roughly)
;
		head	DELAYMS,7,"delayms",docolon
		DW		LIT,0,XDO
DELAYMS0
		DW		PAUSE						; pet the dog
		DW		LIT,30,LIT,0,XDO
DELAYMS1
		DW		XLOOP,DELAYMS1
		DW		XLOOP,DELAYMS0
		DW		EXIT

;
;  LCDINIT		 -- 				initialize the LCD
;
		head	LCDINIT,7,"lcdinit",docolon
		DW		LIT,10,DELAYMS
		DW		LIT,30h,LCDCMD,PCSTORE	; one-line 5x7 (required)
		DW		LIT,10,DELAYMS
		DW		LIT,30h,LCDCMD,PCSTORE	; one-line 5x7 (required)
		DW		LIT,10,DELAYMS
		DW		LIT,30h,LCDCMD,PCSTORE	; one-line 5x7 (required)
		DW		LIT,10,DELAYMS
		DW		LIT,38h,LCDCMD,PCSTORE	; two-line 5x7
		DW		LIT,10,DELAYMS
		DW		LIT,38h,LCDCMD,PCSTORE	; two-line 5x7
		DW		LIT,10,DELAYMS
		DW		LIT,6,LCDCMD,PCSTORE	; shift cursor right on char
		DW		LIT,10,DELAYMS
		DW		LIT,0ch,LCDCMD,PCSTORE	; display on, cursor off
		DW		LIT,10,DELAYMS
		DW		LIT,1,LCDCMD,PCSTORE	; clear display, home cursor
		DW		EXIT


;
;  EMITLCD provides the EMIT function for the MicroView2 LCD screen.
;
;  Note the EMITLCD invokes PAUSE, to hold off watchdog resets.
;
		head	EMITLCD,7,"emitlcd",docolon
		DW		PAUSE									; pet the watchdog
		DW		DUP,LIT,0ah,NOTEQUAL,QBRANCH,EMITL0		; branch if LF
		DW		DUP,LIT,0dh,NOTEQUAL,QBRANCH,EMITL0		; branch if CR
		DW		LCDDATA,PCSTORE
		DW		BRANCH,EMITLX
EMITL0
		DW		DROP
EMITLX
		DW		EXIT


;
;  KEYKPD provides the KEY function for the MicroView2 keypad.
;  This version scans the keypad once and returns a 0 in TOS if
;  no key was pressed.  If one or more keys were pressed, this
;  routine uses the lookup table at keypdtbl to convert the
;  port data into an ASCII character.  If the port data
;  is not found in the table, KEYKPD returns a 0.
;
		head	KEYKPD,6,"keykpd",docolon
		DW		KEYQKPD						; any char available?
		DW		DUP,TOR						; save copy on return stack
		DW		QBRANCH,KEYKPDX				; branch if no key pressed

		DW		LIT,keypdtbl				; get start of table
KEYKPD2
		DW		DUP,CFETCH					; get table entry
		DW		RFROM,DUP,TOR				; get copy of key
		DW		EQUAL,QBRANCH,KEYKPD1		; branch if no match
		DW		DUP,ONEPLUS,CFETCH			; get translation
		DW		RFROM,DROP,TOR				; replace char on return stack
		DW		BRANCH,KEYKPDX				; exit loop
KEYKPD1
		DW		LIT,2,PLUS					; calc next table address
		DW		DUP,LIT,keypdtbl+keypdtblz	; reached the end?
		DW		EQUAL,QBRANCH,KEYKPD2		; loop if more to do
KEYKPDX
		DW		DROP						; remove address
		DW		RFROM						; get translated char
		DW		EXIT



;
;  KEY?KPD provides the KEY? function for the MicroView2 keypad.
;  It returns the inverted value on the keypad port.  Note that
;  this routine does NOT process any detected char!  If no
;  keys are down, this routine returns 0 (FALSE).  If any keys
;  are down, even a combination of keys, this routine returns
;  the inverted raw port value (TRUE).  See also KEYKPD and COLD.
;
;  Note that KEY?KPD invokes PAUSE, to hold off watchdog resets.
;
		head	KEYQKPD,7,"key?kpd",docolon
		DW		PAUSE						; pet the watchdog
		DW		LIT,keypad_clr,PCFETCH		; read keypad to TOS
		DW		LIT,0ffh,XOR				; invert (0=no key down)
		DW		EXIT


;
;  BIN>BCD converts a binary number to its BCD equivalent.  It is
;  used in maintaining the RTC.
;
;  This word ONLY handles binary numbers in the range 0-59!
;
		head	BINBCD,7,"bin>bcd",docolon
		DW		DUP,LIT,0					; convert to 32 bits
		DW		10,UMSLASHMOD				; 32/16 divide, quot in TOS
		DW		TWOSTAR,TWOSTAR,TWOSTAR,TWOSTAR		; move to top nybble
		DW		PLUS
		DW		EXIT


;
;  BCD>BIN converts a BCD number to its binary equivalent.  It is
;  used in maintaining the RTC.
;
;  This word ONLY handles BCD numbers in the range 00-59!
;
		head	BCDBIN,7,"bcd>bin",docolon
		DW		DUP,LIT,0fh,AND
		DW		SWOP,TWOSLASH,TWOSLASH,TWOSLASH,TWOSLASH
		DW		LIT,10,UMSTAR,DROP				; only need 16 bits
		DW		PLUS
		DW		EXIT


;
;  LCDRC        r c --				move LCD cursor to row r, column c
;
		head	LCDRC,5,"lcdrc",docolon
		DW		SWOP,LIT,3,AND					; force to 0-3 range
		DW		LIT,lcdpostbl,PLUS,CFETCH		; get addr to start of row
		DW		PLUS							; add to column (better be in range!)
		DW		LCDCMD,PCSTORE					; go to r,c
		DW		EXIT


;
;  LCDCLS		    --				clear LCD screen, move to home
;
		head	LCDCLS,6,"lcdcls",docolon
		DW		LIT,1,LCDCMD,PCSTORE
		DW		EXIT


;
;  LCDCURSOR		c --			set LCD cursor type
;				options are: 0=none, 1=block, 2=line, 3=block+line
;
		head	LCDCURSOR,9,"lcdcursor",docolon
		DW		LIT,3,AND					; force to proper range
		DW		LIT,0ch,OR					; calc correct command
		DW		LCDCMD,PCSTORE				; send to LCD
		DW		EXIT


;
;  CSIO!		c --			write byte to CSIO
;				writes c to CSIO, sets flag to start serial xfer
;
;  This word exchanges serial data with the CSIO system in the Z180.
;  I've included CBITREV to reverse all bits in the byte.  This
;  presumes your hardware will talk to nearly any device in the world
;  EXCEPT a Zilog device!
;
		head	CSIOSTORE,5,"csio!",docolon
		DW		CBITREV						; do it Zilog's way
		DW		LIT,TRDR,PCSTORE			; write data to xmit reg
		DW		LIT,CNTR,PCFETCH			; read CSIO control reg
		DW		LIT,10h,OR					; add in TE bit to start xfer
		DW		LIT,CNTR,PCSTORE			; start xfer
CSIOS1
		DW		PAUSE						; pet the watchdog
		DW		LIT,CNTR,PCFETCH			; get CSIO status
		DW		LIT,080h,AND				; test EF flag
		DW		QBRANCH,CSIOS1				; loop until done (dangerous!)
		DW		EXIT




;
;  CSIO@		-- c			read byte from CSIO
;				sets flag to start serial xfer, reads c from CSIO
;
;  This word exchanges serial data with the CSIO system in the Z180.
;  I've included CBITREV to reverse all bits in the byte.  This
;  presumes your hardware will talk to nearly any device in the world
;  EXCEPT a Zilog device!
;
		head	CSIOFETCH,5,"csio@",docolon
		DW		LIT,CNTR,PCFETCH			; read CSIO control reg
		DW		LIT,20h,OR					; add in RE bit to start xfer
		DW		LIT,CNTR,PCSTORE			; start xfer
CSIOF1
		DW		PAUSE						; pet the watchdog
		DW		LIT,CNTR,PCFETCH			; get CSIO status
		DW		LIT,080h,AND				; test EF flag
		DW		QBRANCH,CSIOF1				; loop until done (dangerous!)
		DW		LIT,TRDR,PCFETCH			; read data from rcv reg
		DW		CBITREV						; compensate for Zilog's order
		DW		EXIT


;
;  The following words manipulate the real-time clock (RTC)
;  on the MicroView PCB.  This is a Motorola 68hc68t1 chip,
;  which uses serial I/O for communications.
;


;
;  (3RTC!)			n1 n2 n3 -- 	store three values to RTC
;				The RTC must already be enabled and the first
;				address must have already been transferred.  Chars
;				sent with (3rtc!) are automatically converted to
;				BCD before transmission.
;
		head	P3RTCS,7,"(3rtc!)",docolon
		DW		BINBCD,CSIOSTORE
		DW		BINBCD,CSIOSTORE
		DW		BINBCD,CSIOSTORE
		DW		EXIT


;
;  (3RTC@)			-- n1 n2 n3 	read three values from RTC
;				The RTC must already be enabled and the first
;				address must have already been transferred.  Chars
;				read with (3rtc@) are automatically converted to
;				BCD after reception.
;
		head	P3RTCF,7,"(3rtc@)",docolon
		DW		CSIOFETCH,BCDBIN
		DW		CSIOFETCH,BCDBIN
		DW		CSIOFETCH,BCDBIN
		DW		EXIT


;
;  RTCENABLE		--				enable RTC for transfer
;
		head	RTCENABLE,9,"rtcenable",docolon
		DW		LIT,keypad_set,PCFETCH		; set RTC SS line high
		DW		DROP						; lose the byte read
		DW		EXIT


;
;  RTCDISABLE		--				disable RTC for transfer
;
		head	RTCDISABLE,10,"rtcdisable",docolon
		DW		LIT,keypad_clr,PCFETCH		; clear RTC SS line low
		DW		DROP						; lose the byte read
		DW		EXIT


;
;  (RTC!)			c a --			write char to RTC reg at a
;				This routine writes one byte to the RTC.
;
		head	PRTCSTORE,6,"(rtc!)",docolon
		DW		RTCENABLE					; access the RTC
		DW		CSIOSTORE					; send addr to RTC
		DW		CSIOSTORE					; now send char
		DW		RTCDISABLE					; release the RTC
		DW		EXIT

;
;  (RTC@)			a -- c			read char from RTC reg at a
;				This routine reads one byte to the RTC.
;
		head	PRTCFETCH,6,"(rtc@)",docolon
		DW		RTCENABLE					; access the RTC
		DW		CSIOSTORE					; send addr to RTC
		DW		CSIOFETCH					; now read char
		DW		RTCDISABLE					; release the RTC
		DW		EXIT


;
;  TIME@			-- s m h		read hours, minutes, and seconds from RTC
;				values returned are automatically converted from BCD to binary.
;
		head	TIMEFETCH,5,"time@",docolon
		DW		RTCENABLE					; access the RTC
		DW		LIT,20h,CSIOSTORE			; send addr of seconds reg
		DW		P3RTCF						; read three bytes
		DW		RTCDISABLE					; release the clock
		DW		EXIT


;
;  TIME!			s m h -- 		send hours, minutes, and seconds to RTC
;				values sent are automatically converted from binary to BCD.
;
		head	TIMESTORE,5,"time!",docolon
		DW		RTCENABLE					; access the RTC
		DW		LIT,20h,CSIOSTORE			; send addr of seconds reg
		DW		SWOP,ROT					; align the bytes -> h m s
		DW		P3RTCS						; write three bytes
		DW		RTCDISABLE					; release the clock
		DW		EXIT


;
;  RTC-ON			--				turn on the RTC
;
		head	RTCON,6,"rtc-on",docolon
		DW		LIT,0b4h					; RTC on, 32kHz xtal, clkout low
		DW		LIT,0b1h					; addr of RTC clock control reg
		DW		PRTCSTORE					; send it
		DW		EXIT


;
;  RTC-OFF			--				turn off the RTC
;
		head	RTCOFF,7,"rtc-off",docolon
		DW		LIT,034h					; RTC off, 32kHz xtal, clkout low
		DW		LIT,0b1h					; addr of RTC clock control reg
		DW		PRTCSTORE					; send it
		DW		EXIT