ekipan · June 8, 2026 01:58
diff --git a/asm.fs b/asm.fs
 \ \ durexforth 6510 assembler.
 \ search "goals" and "examples".

 hex latest \ private:

 here \ address mode encoding tables:
 0909 , 1505 , 0115 , aa11 , \ enc0
 aaaa , 1d0d , aa19 , aaaa ,
 00aa , 1404 , aa14 , aaaa , \ enc1
 aaaa , 1c0c , aa1c , 2caa ,
 \ # a    x m   x) y   . )y   0-6 zp
 \ . .    x m    . y   )  .   a-f abs
 dup constant enc0  10 + constant enc1

 \ multimode instruction parameters:
 0 value op   \ 0-ff base opcode.
 0 value bads \ 0-ffff illegal modeset.
 0 value enc  \ enc0/1 table addr.

 \ ii (o-:-) implied: clc, inx, pha,
 \ bi (o-:-) branching: bcc -, bne 2 #,
 \ mi0 mi1 (bo-:-) multimode: lda w )y,
 : ixn ( aab-) to bads to enc c@ to op ;
 : mixn ( aa-) over 1+ @ ixn ;
 : ii  create c, does> c@ c, ;  \ [1]:
 : bi  create c, does> enc1 fffd ixn ;
 : mi0  create c, , does> enc0 mixn ;
 : mi1  create c, , does> enc1 mixn ;

 : ?err ( f-) abort" asm" ;
 : br- ( adest abranchixn -- nrel )
  2+ - dup 80 -80 within ?err ;
 : bad? ( m-f) 1 swap lshift  bads and ;
 : op, ( m-) enc + c@  op or c, ;
 : ?op, ( m-) dup bad? ?err op, ;
 : ?ixn, ( am-) over ff00 and  over bad?
  or if 8 + ?op, , else op, c, then ;

 latest \ public:

 \ a, (-) #, (n-) m, x, y, x), ... (a-)
 : a,  0 ?op, ;      : #,  1 ?op, c, ;
 : m,  2 ?ixn, ;     : x,  3 ?ixn, ;
 : y,  4 ?ixn, ;     : x), 5 ?op, c, ;
 : )y, 6 ?op, c, ;   : ),  f ?op, , ;

 : l, ( n-) lsb + x, ;   \ param stack.
 : h, ( n-) msb + x, ;
 : :- ( -a) here ;       \ branching.
 : -, ( a-) here br- #, ; \ [1]
 : +, ( -a) here -2 #, ;  \ [2]
 : :+ ( a-) here over br- swap 1+ c! ;

 \ table: opcode implied/branch name
 00 ii brk,  18 ii clc,  d8 ii cld,
 58 ii cli,  b8 ii clv,  ca ii dex,
 88 ii dey,  e8 ii inx,  c8 ii iny,
 ea ii nop,  48 ii pha,  08 ii php,
 68 ii pla,  28 ii plp,  40 ii rti,
 60 ii rts,  38 ii sec,  f8 ii sed,
 78 ii sei,  aa ii tax,  a8 ii tay,
 ba ii tsx,  8a ii txa,  9a ii txs,
 98 ii tya,  90 bi bcc   b0 bi bcs
 f0 bi beq   30 bi bmi   d0 bi bne
 10 bi bpl   50 bi bvc   70 bi bvs

 \ table: bads opcode class name [3]
 e391 00 mi0 ora  e391 20 mi0 ana \ [4]
 e391 40 mi0 eor  e391 60 mi0 adc
 e393 80 mi0 sta  e391 a0 mi0 lda
 e391 c0 mi0 cmp  e391 e0 mi0 sbc
 f2f2 01 mi0 asl  f2f2 21 mi0 rol
 f2f2 41 mi0 lsr  f2f2 61 mi0 ror
 f3f3 c1 mi0 dec  f3f3 e1 mi0 inc
 fbeb 81 mi0 stx  fbf3 80 mi1 sty
 ebe9 a2 mi1 ldx  f3f1 a0 mi1 ldy
 fbf9 c0 mi1 cpy  fbf9 e0 mi1 cpx
 7bff 40 mi1 jmp  fbff 14 mi1 jsr
 fbfb 20 mi1 bit

 : code header ;  : end-code ;

 : hidden ( nt1 nt2 -- ) latest - tuck -
  latest swap dup to latest rot move ;

 ( private public ) hidden decimal

 \ [1] use #, for branch rel8 operand.
 \ [2] unresolved +, loops -2 instead of
 \  fallthru. recover w/ restore key.
 \ [3] bitsets inverted vs ragsdale's.
 \ [4] ana avoids and name clash.

 \ goals: understanding, fun, size.
 \ code based on: ragsdale's assembler,
 \  forth dimensions v3n5 page 143.
 \ more info: https://redd.it/1sdh2xn

 \ clc, inx, pha, ... (-) assemble ixn.
 \ beq lda jmp ... (-) set ixn values.
 \ a, (-) #, l, h, (n-) m, x, y, x), )y,
 \ ), -, (a-) +, (-a) assemble ixn.
 \ :- (-a) :+ (a-) branch targets.

 \ examples    durexforth    ragsdale
 \ --------    ----------    --------
 \ clc,             clc,          clc,
 \ bne +,   +branch bne,       0= if,
 \ rol a,           rol,a      .a rol,
 \ jmp $73 m,   $73 jmp,      $73 jmp,
 \ ldy 0 #,       0 ldy,#     0 # ldy,
 \ lda w )y,      w lda,(y)  w )y lda,
 \ ora 0 l,     lsb ora,x     bot ora,
 \ ana 1 h,  msb 1+ and,x  sec 1+ and,

 \     -- branching examples --
 \ lda $f4 #,  :-  cmp $d014 m,  bne -,
 \ a9 f4           cd 14 d0      d0 fb
 \ inc w m,  bne +,  inc w 1+ m,  :+
 \ e6 8b     d0 02   e6 8c

 \ future work:
 \ 1. asm-all.fs: exercise every
 \  ixn/mode combo w/ old df syntax.
 \ 2. asm-test.fs, include 1, then
 \  this, then translate new syntax to
 \  old, then 1 again, compare output.
 \ 3. once tested, translate all df
 \  assembly modules and rewrite docs.
	\ \ durexforth 6510 assembler.
	\ search "goals" and "examples".

	hex latest \ private:

	here \ address mode encoding tables:
	0909 , 1505 , 0115 , aa11 , \ enc0
	aaaa , 1d0d , aa19 , aaaa ,
	00aa , 1404 , aa14 , aaaa , \ enc1
	aaaa , 1c0c , aa1c , 2caa ,
	\ # a x m x) y . )y 0-6 zp
	\ . . x m . y ) . a-f abs
	dup constant enc0 10 + constant enc1

	\ multimode instruction parameters:
	0 value op \ 0-ff base opcode.
	0 value bads \ 0-ffff illegal modeset.
	0 value enc \ enc0/1 table addr.

	\ ii (o-:-) implied: clc, inx, pha,
	\ bi (o-:-) branching: bcc -, bne 2 #,
	\ mi0 mi1 (bo-:-) multimode: lda w )y,
	: ixn ( aab-) to bads to enc c@ to op ;
	: mixn ( aa-) over 1+ @ ixn ;
	: ii create c, does> c@ c, ; \ [1]:
	: bi create c, does> enc1 fffd ixn ;
	: mi0 create c, , does> enc0 mixn ;
	: mi1 create c, , does> enc1 mixn ;

	: ?err ( f-) abort" asm" ;
	: br- ( adest abranchixn -- nrel )
	2+ - dup 80 -80 within ?err ;
	: bad? ( m-f) 1 swap lshift bads and ;
	: op, ( m-) enc + c@ op or c, ;
	: ?op, ( m-) dup bad? ?err op, ;
	: ?ixn, ( am-) over ff00 and over bad?
	or if 8 + ?op, , else op, c, then ;

	latest \ public:

	\ a, (-) #, (n-) m, x, y, x), ... (a-)
	: a, 0 ?op, ; : #, 1 ?op, c, ;
	: m, 2 ?ixn, ; : x, 3 ?ixn, ;
	: y, 4 ?ixn, ; : x), 5 ?op, c, ;
	: )y, 6 ?op, c, ; : ), f ?op, , ;

	: l, ( n-) lsb + x, ; \ param stack.
	: h, ( n-) msb + x, ;
	: :- ( -a) here ; \ branching.
	: -, ( a-) here br- #, ; \ [1]
	: +, ( -a) here -2 #, ; \ [2]
	: :+ ( a-) here over br- swap 1+ c! ;

	\ table: opcode implied/branch name
	00 ii brk, 18 ii clc, d8 ii cld,
	58 ii cli, b8 ii clv, ca ii dex,
	88 ii dey, e8 ii inx, c8 ii iny,
	ea ii nop, 48 ii pha, 08 ii php,
	68 ii pla, 28 ii plp, 40 ii rti,
	60 ii rts, 38 ii sec, f8 ii sed,
	78 ii sei, aa ii tax, a8 ii tay,
	ba ii tsx, 8a ii txa, 9a ii txs,
	98 ii tya, 90 bi bcc b0 bi bcs
	f0 bi beq 30 bi bmi d0 bi bne
	10 bi bpl 50 bi bvc 70 bi bvs

	\ table: bads opcode class name [3]
	e391 00 mi0 ora e391 20 mi0 ana \ [4]
	e391 40 mi0 eor e391 60 mi0 adc
	e393 80 mi0 sta e391 a0 mi0 lda
	e391 c0 mi0 cmp e391 e0 mi0 sbc
	f2f2 01 mi0 asl f2f2 21 mi0 rol
	f2f2 41 mi0 lsr f2f2 61 mi0 ror
	f3f3 c1 mi0 dec f3f3 e1 mi0 inc
	fbeb 81 mi0 stx fbf3 80 mi1 sty
	ebe9 a2 mi1 ldx f3f1 a0 mi1 ldy
	fbf9 c0 mi1 cpy fbf9 e0 mi1 cpx
	7bff 40 mi1 jmp fbff 14 mi1 jsr
	fbfb 20 mi1 bit

	: code header ; : end-code ;

	: hidden ( nt1 nt2 -- ) latest - tuck -
	latest swap dup to latest rot move ;

	( private public ) hidden decimal

	\ [1] use #, for branch rel8 operand.
	\ [2] unresolved +, loops -2 instead of
	\ fallthru. recover w/ restore key.
	\ [3] bitsets inverted vs ragsdale's.
	\ [4] ana avoids and name clash.

	\ goals: understanding, fun, size.
	\ code based on: ragsdale's assembler,
	\ forth dimensions v3n5 page 143.
	\ more info: https://redd.it/1sdh2xn

	\ clc, inx, pha, ... (-) assemble ixn.
	\ beq lda jmp ... (-) set ixn values.
	\ a, (-) #, l, h, (n-) m, x, y, x), )y,
	\ ), -, (a-) +, (-a) assemble ixn.
	\ :- (-a) :+ (a-) branch targets.

	\ examples durexforth ragsdale
	\ -------- ---------- --------
	\ clc, clc, clc,
	\ bne +, +branch bne, 0= if,
	\ rol a, rol,a .a rol,
	\ jmp $73 m, $73 jmp, $73 jmp,
	\ ldy 0 #, 0 ldy,# 0 # ldy,
	\ lda w )y, w lda,(y) w )y lda,
	\ ora 0 l, lsb ora,x bot ora,
	\ ana 1 h, msb 1+ and,x sec 1+ and,

	\ -- branching examples --
	\ lda $f4 #, :- cmp $d014 m, bne -,
	\ a9 f4 cd 14 d0 d0 fb
	\ inc w m, bne +, inc w 1+ m, :+
	\ e6 8b d0 02 e6 8c

	\ future work:
	\ 1. asm-all.fs: exercise every
	\ ixn/mode combo w/ old df syntax.
	\ 2. asm-test.fs, include 1, then
	\ this, then translate new syntax to
	\ old, then 1 again, compare output.
	\ 3. once tested, translate all df
	\ assembly modules and rewrite docs.
No results found