asm.mu4

| This file is part of muforth: https://muforth.dev/
|
| Copyright 2002-2025 David Frech. (Read the LICENSE for details.)

( Assembler for PIC18 8 bit microcontrollers.)

loading PIC18 assembler

hex

( Debug)
: _     char _ hold ;
: ####  # # # # ;
: .b  radix preserve  binary  <# #### _ #### _ #### _ #### #> type ;

: op,  \m , ;
| : op,  ( compile)  dup \m ,  ( and print)  .b  cr ;

( Tests to see if a value fits into a field of a certain bit width.)
: ufits?  ( value bits - f)     u>>        0= ;   ( unsigned)
: sfits?  ( value bits - f)   1- >>  1+  2 u< ;   ( signed)

: mask  ( n - mask)  1 swap << ;
: ones  ( n - mask)  mask  1- ;  ( create a mask of n 1s)

( Immediate fields)

| XXX add code like with two jump lengths here? So we have a version that
| complains, and one that maybe just warns? Like for ldi, addi, and friends?

( XXX compare to other code - AVR? ARM?. This seems clunky.)

: imm   ( imm op #bits - op')
   rot swap  ( op imm #bits)  2dup ufits? if  ones and  or  ^  then
   error" imm value out of range" ;

:  i7  ( imm op - op')    7 imm ;
: i12  ( imm op - op')  #12 imm ;

( For byte literals, don't check whether they fit. Just truncate them.)
:  i8  ( imm op - op')  swap  0ff and  or ;

( Zero ops.)
forth
: 0op  constant does> @ op, ;
assembler
0000 0op  nop

0003 0op  sleep
0004 0op  clrwdt   ( clear watchdog timer)
0005 0op  push     ( inc STKPTR; TOS U:H:L = pc + 2)
0006 0op  pop      ( dec STKPTR)
0007 0op  daw      ( decimal adjust w)

0008 0op  prog@   ( tblrd*)    ( read program memory)
0009 0op  prog@+  ( tblrd*+)   ( read program memory, post incr)
000a 0op  prog@-  ( tblrd*-)   ( read program memory, post decr)
000b 0op  prog+@  ( tblrd+*)   ( read program memory, pre incr)

000c 0op  prog!   ( tblwt*)    ( write program memory)
000d 0op  prog!+  ( tblwt*+)   ( write program memory, post incr)
000e 0op  prog!-  ( tblwt*-)   ( write program memory, post decr)
000f 0op  prog+!  ( tblwt+*)   ( write program memory, pre incr)

0010 0op  iret       ( return from interrupt; restore from stack)
0011 0op  iret.s     ( return from interrupt; restore from shadow regs)

0012 0op  ret        ( return from subroutine; restore from stack)
0013 0op  ret.s      ( return from subroutine; restore from shadow regs)

00ff 0op  reset
forth

| Dealing with the terrible fact that the data memory space - RAM and the
| i/o registers - is *banked*. The data space is made up of a sequence of
| 256 byte banks - pages - and so requires more than 8 bits of address. The
| high bits are held in the BSR - bank select register.
|
| The number of bits in the bank register varies by device. It is defined
| in the chip's equates file.

( XXX Need better names than "f" and ">f8".)

( Extracting the bank or 8-bit offset from a data space address.)
: >bank   ( f - bank)    [ #bsr-bits ones 8 << #] and ;
: >f8     ( f - offset)  00ff and ;

| "bank" instructions set this. We get a static lexical sense of what its
| value might be when an instruction is executed. It's not perfect, but we
| can warn the user in the case of mismatches.
|
| current-bank is set to the base address of the bank, not its index
| number.

variable current-bank

| bank takes an address in the data memory and strips off the bank part -
| the high byte. As a convenience, bank leaves f on the stack.

assembler
: bank  ( f - f)
   dup  >bank  dup current-bank !  8 u>>  0100 or  op, ;  ( movlb)
forth

| afop is a 2op with just an "a" bit, no "d" bit;
| dafop is a 2op with both an "a" bit and a "d" bit.

: ~d  ( op - op')  ( toggle d bit)  0200 xor ;
: afop    constant does> @  ( af op)     9 imm      op, ;
: dafop   constant does> @  ( daf op)  #10 imm  ~d  op, ;

( check that address given matches current bank, then truncate to 8 bits.)
: ?bank  ( f - f8)
   dup >f8  swap >bank  current-bank @ =  if ^ then
   warn" address doesn't match current bank setting" ;

( Check that an address is a valid stack offset.)
.ifdef xinst
: ?sp-offset  ( f - f8)
   dup 060 u< if ^ then  ( ok)
   error" stack offset out of range" ;
.else
: ?sp-offset  ( f - f8)
   error" stack offset only available when XINST set" ;
.then

| @ram is always the beginning of the access ram bank. Likewise, STATUS is
| always in the access i/o bank.

: access-ram?  ( f - within?)  @ram             [ @ram 060 + #]              within ;
: access-io?   ( f - within?)  [ \eq STATUS >bank dup  060 + #]  [ 100 + #]  within ;

( Check that an address is a valid "access bank" address. Return offset.)
: ?access  ( f - f8)
   dup >f8  swap
.ifdef xinst
   dup access-ram? if error" access ram inaccessible when XINST set" then
.else
   dup access-ram? if drop ^ then  ( ok)
.then
   dup access-io? if drop ^ then  ( ok)
   error" invalid access bank address" ;

( Check that address given is *only* an 8 bit offset.)
: ?f8   dup >bank if  error" more than 8 bits in f"  then ;

| Microchip uses an offset in square brackets - "[n]" - to designate a
| value on a stack, using FSR2 as the stack pointer. This requires the
| XINST config bit to be set.

assembler
:  ]   ( offset - bits)  ( "stack offset")  ?sp-offset ;       ( clear "a" bit)
:  )   ( f      - bits)  ( "access bank")   ?access ;          ( clear "a" bit)
: b)   ( f      - bits)  ( "banked")        ?bank  0100 or ;   ( set "a" bit)
( XXX / or // for banked?)


| In dafop we've reversed the sense of the d bit. Now set means store to w,
| and clear means store to f, which we think should be the default.

| : !    ( f - bits)  ( "store to f")  ?f8     0200 or ;  ( set "d" bit)
: w    ( f - bits)  ( "store to w")  ?f8     0200 or ;  ( set "!d" bit)

0200  afop mul   ( mulwf)  (        PRODH:PRODL = w * f)
0400 dafop dec   ( decf)   ( DNVCZ  f/w = f - 1)
forth

: i8op  constant  does> @  ( imm op)  i8  op, ;

assembler
0800 i8op negi   ( sublw)  ( DNVCZ  w = k - w)  ( ie, negate w and add k)
0900 i8op ori    ( iorlw)  ( NZ     w = k or w)
0a00 i8op xori   ( xorlw)  ( NZ     w = k xor w)
0b00 i8op andi   ( andlw)  ( NZ     w = k and w)
0c00 i8op reti   ( retlw)  (        w = k, and return)
0d00 i8op muli   ( mullw)  (        w = k * w)
0e00 i8op ldi    ( movlw)  (        w = k)
0f00 i8op addi   ( addlw)  ( DNVCZ  w = k + w)

| NOTE: Some of these operations are 1ops. These operate on F not W! But
| they can store the result in F *or* W.

1000 dafop or     ( iorwf)   ( NZ     f/w = w or f)
1400 dafop and    ( andwf)   ( NZ     f/w = w and f)
1800 dafop xor    ( xorwf)   ( NZ     f/w = w xor f)

1c00 dafop com    ( comf)    ( NZ     f/w = ~f)

2000 dafop adc    ( addwfc)  ( DNVCZ  f/w = w + f + C)
2400 dafop add    ( addwf)   ( DNVCZ  f/w = w + f)
2800 dafop inc    ( incf)    ( DNVCZ  f/w = f + 1)
2c00 dafop decsz  ( decfsz)  (        f/w = f - 1, skip if zero)

3000 dafop rrc    ( rrcf)    ( NCZ    rotate right thru carry)
3400 dafop rlc    ( rlcf)    ( NCZ    rotate left thru carry)
3800 dafop rot4   ( swapf)   (        f/w = swap_nybbles[f])
3c00 dafop incsz  ( incfsz)  (        f/w = f + 1, skip if zero)

4000 dafop ror    ( rrncf)    ( NZ     rotate right not thru carry)
4400 dafop rol    ( rlncf)    ( NZ     rotate left not thru carry)

4800 dafop incsnz  ( infsnz)  (       f/w = inc f, skip nz)
4c00 dafop decsnz  ( dcfsnz)  (       f/w = dec f, skip nz)

5000 afop ld   ( movf, with d clr)  ( NZ)
5200 afop tst  ( movf, with d set)  ( NZ)

( NOTE: borrow is the complement of carry!)
( XXX decide about rsub here and rsubi... Do these names make sense?)

5400 dafop rsbb   ( subfwb)  ( DNVCZ  f/w = w - f - borrow)
5800 dafop sbb    ( subwfb)  ( DNVCZ  f/w = f - w - borrow)
5c00 dafop sub    ( subwf)   ( DNVCZ  f/w = f - w)

( NOTE: There is no destination for these, so no d bit.)
( But here again... sub/cmp is "standardly" f - w, not w - f.)
6000 afop cmpslt  ( cpfslt          f - w, skip if lt, unsigned)
6200 afop cmpseq  ( cpfseq          f - w, skip if eq)
6400 afop cmpsgt  ( cpfsgt          f - w, skip if gt, unsigned)
6600 afop tstsz   ( tstfsz          test f, skip if 0)

6800 afop set     ( setf            f = ff  no status chg)
6a00 afop clr     ( clrf     Z      f = 0   Z = 1)
6c00 afop neg     ( negf     DNVCZ  f = -f)
6e00 afop st      ( movwf           f = w   no status chg)
forth

: bitop   constant does> @  ( bit# f op)  9 imm  swap 7 and 9 << or  op, ;
assembler
7000 bitop btog   ( btg             bit toggle f)
8000 bitop bset   ( bsf             bit set f)
9000 bitop bclr   ( bcf             bit clr f)

( XXX bset? bclr?  what about the skip?)
( XXX somehow interface these with the control structure words)
a000 bitop btstss  ( btfss          bit test, skip set)
b000 bitop btstsc  ( btfsc          bit test, skip clr)

( XXX need movffl)
: movff   ( fsrc fdest)  swap  c000 i12 op,  f000 i12 op, ;
forth

: too-far   error" relative jump out of range" ;
: >offset?  ( offset #bits - masked-offset fits)
   push  dup  r@ ones and  ( offset masked-offset)  swap  pop sfits? ;

: rel11
   constant does> @  ( dest op)  swap  \m here - 2/ 1-  #11 >offset?
   if  or op,  pop cell+ push ( skip error routine)
   then  ( return to error routine) ;

| These versions compile the code, but if it doesn't fit they call the
| following error routine.

d000 rel11 _rjmp
d800 rel11 _rcall

assembler
: rjmp   _rjmp   too-far ;  ( complain if too far)
: rcall  _rcall  too-far ;  ( ditto)
forth

| d000 - d7ff rjmp
| d800 - dfff rcall - see below for smart versions of these

( e000 - e7ff: Conditional branches - see below)

( e800 - ebff: unimplemented/extended instructions - See below)

| For long jump/call, the embedded constant is the _word_ address of the
| destination; the low 8 bits are in the first word; the high 12 bits are
| in the extension word.

: ljmp
   constant does> @  ( dest op)  over u2/ 0ff and or op,  9 u>>  f000 i12 op, ;

| If reg is not a valid FSR address, we get it back as the index. This is
| useful for addulnk and subulnk.

: fsr>index  ( reg - n)
   dup \eq FSR0 = if  drop 0 ^  then
   dup \eq FSR1 = if  drop 1 ^  then
   dup \eq FSR2 = if  drop 2 ^  then
   ( return reg unchanged) ;

| For FSRs - file select registers - which we are going to rename "address"
| registers - the high 4 bits are in the first word; the low 8 or 10 bits -
| it depends whether BSR is 4 bits or 6 - are in the extension.

assembler
: lda  ( offset reg)  ( lfsr, which we call "load address")
   fsr>index 4 <<  ee00 or
   over [ #bsr-bits 4 +      #] u>>  0f and  or op,
        [ #bsr-bits 4 + ones #] and  f000 or op, ;

ec00 ljmp call
ed00 ljmp call.s  ( save W, STATUS, BSR in shadow regs.)
ef00 ljmp jmp

( Smart call and jump)
: j   ( dest)  _rjmp   \a jmp ;   ( call jmp if too far for rjmp)
: c   ( dest)  _rcall  \a call ;  ( call call if too far for rcall)
forth

| f000 - ffff is a nop, and is used as an extension word for two-word
| instructions.

| --------------------------------------------------------------------------
| Extended instructions: e800 to ebff, plus 0014 (callw)
| --------------------------------------------------------------------------

.ifdef xinst

| If the XINST bit is set in the configuration space, a few instructions
| are added. These are useful for C compilers, but might very well be
| useful to assembler and Forth hackers too.

( XXX should we check if imm < 0 and do sub automagically?)
: add-a  constant does> @  ( imm reg op)  swap fsr>index 6 << or  6 imm  op, ;

assembler
0014 0op callw       ( push pc + 2; pcl = w, pch = pclath, pcu = pclatu)

e800 add-a adda      ( addfsr) ( add literal to fsr)
: addulnk  3 \a adda ;         ( add literal to fsr 2 and return)

e900 add-a suba      ( subfsr) ( sub literal from fsr)
: subulnk  3 \a suba ;         ( sub literal from fsr 2 and return)

ea00 i8op pushi      ( pushl)  ( store lit at FSR2; dec FSR2
                                 ie, post-decrement)

( In movsf and movss, the s offsets are added to FSR2)
: movsf   ( ssrc fdest)  swap  eb00  i7 op,  f000 i12 op, ;
: movss   ( ssrc sdest)  swap  eb80  i7 op,  f000  i7 op, ;
forth

.then  ( ifdef xinst)


| comment
| =============================================================================
| Digression on the PIC18's condition code idiosyncrasies, and an explanation
| of how carry and borrow work.
|
| First, let's define how condition code flags represent the results of a
| signed subtract (or compare). If we execute X - Y, where both are _signed_
| values, then the N (negative), V (overflow) and Z (zero) bits are set as
| follows:
|
| Let S = N xor V. Then
|
|   (LT)  X < Y  ==   S
|   (GE)  X >= Y ==  !S
|   (GT)  X > Y  ==  !S and !Z
|                == !(S or   Z)  (deMorgan's law)
|   (LE)  X <= Y ==   S or   Z
|
| I've written on the left the traditional "conditional branch" names for
| each relation.
|
| The PIC18 conditional branch instructions only let us test one of the four
| condition code bits at a time. There are no "bgt" or "ble" instructions. We
| have to make our own.
|
| Things are a bit simpler when we subtract or compare _unsigned_ values,
| mostly because there is no possiblity of overflow. But before discussing
| that we have to understand what the carry bit represents. Since the natural
| way of doing subtraction to _add_ the two's complement of the subtrahend -
| ie:
|
|   X - Y == X + (-Y)
|
| and since two's complement is the one's complement plus one:
|
|   -Y == ~Y + 1
|
| we can write subtract as
|
|   X - Y == X + ~Y + 1
|
| and subtract with a _borrow_ as
|
|   X - Y - 1 == X + ~Y
|
| Note something odd here: the carry in complemented: we carry in a one when
| there is no carry in (ie, no borrow); and carry in a zero when there _is_ a
| borrow. So, carry = ~borrow.
|
| There are only four architectures that I know of that represent carry this
| way: ARM, 6502, MSP430, and the PIC18. All others use a synthesized carry,
| where carry = borrow. Since the PIC18 is one of the former in the
| following we'll understand C = 0 to mean borrow, and C = 1 to mean no
| borrow.
|
| So let's define how X - Y affects the condition codes, if X and Y are
| _unsigned_.
|
|   (LO)  X < Y   ==   !C
|   (HS)  X >= Y  ==    C
|   (HI)  X > Y   ==    C and !Z
|                 == !(!C or   Z)   (deMorgan's law)
|   (LS)  X <= Y  ==   !C or   Z
|
| Again I've written traditional conditional branch names for these
| conditions. LO == lower; HS == higher or same; HI == higher; LS == lower or
| same.
|
| Here again, since we can only test one bit (C) we have to synthesize HI and
| LS by swapping the arguments to the compare or subtract.
| =============================================================================

| Conditional jump:
|
|    1110 0ccs dddd dddd      c=cond, s=sense, d=dest offset
|
| Unconditional short jump:
|
|    1101 0ddd dddd dddd      d=dest offset
|
| Offset is a signed _word_ offset from the following instruction.


: cond?  ( op - f)  f800 and e000 = ;  ( true if a cond jump)
: cond   constant ;
assembler
e000 cond 0=   ( bz)
e300 cond u<   ( bnc aka bcc aka blo - carry is ~borrow)
e600 cond 0<   ( bn  aka bmi)

e200 cond CS  ( bc  aka bcs)
e300 cond CC  ( bnc aka bcc)

e400 cond VS  ( bov  aka bvs)
e500 cond VC  ( bnov aka bvc)

d000 cond never  ( jump always!)

( not doesn't work on never, so be careful!)
: not  ( cond - !cond)  ( invert sense of test)
   dup cond? if ( cond jmp)  0100 xor  then ;
forth


( Jump offsets are relative to the _following_ instruction.)

: offset-size  ( jmp - #bits)  cond? if  8 ^  then  #11 ;

assembler
( Resolve a relative jump from src to dest.)
: resolve  ( src dest)
   over - 2/  push  ( offset)
   2 - dup  image-@  pop  ( src-2 jmp offset)
   over offset-size  >offset? if  or  swap image-!  ^  then
   too-far ;

( Control structure words.)
: if      ( cond - src )  \a not  op,  \m here ;
: then    ( src  -     )  \m here   \a resolve ;
: else    ( src1 - src2)  \a never  \a if  swap  \a then ;

: begin   ( - dest)       \m here ;
: until   ( dest)         \a if  swap  \a resolve ;
: again   ( dest)         \a never  \a until ;
: while   ( dest - src dest)   \a if  swap ;
: repeat  ( src dest)     \a again  \a then ;
forth