\ Assembler für den 80C165 ( 25.07.97/KK )
\
\ System: KKF_PC V1.2/2
\ Änderungen: 25.07.97 KK: Umsetzung auf GFORTH
\
\ Hinweise:
\ Dieser Assembler wurde für das KK-FORTH entwickelt und unter-
\ liegt dem Copyright von Ing. Büro Klaus Kohl. Es unterstützt
\ auch die Prozessoren 80C166 und 80C167, wobei dann die zusätz-
\ lichen Befehle nicht genutzt werden dürfen.
\ (c) 1995/1996 Ing. Büro Klaus Kohl
include asm/basic.fs
also Assembler Definitions
: | ;
: restrict ;
: u2/ 1 rshift ;
\ Redefinitionen wegen Namenskonflikte ( 14.01.96/KK )
| ' , Alias dic,
| ' c, Alias dic,c
' Forth Alias [Forth] immediate
Forth Definitions
' Assembler Alias [Assembler] immediate
Assembler Definitions
\ Alias-Definitionen ( 06.01.96/KK )
: asshere ( -- dp ) X here ; \ Zieladresse
: ass,c ( byte -- ) X c, ; \ Byte compilieren
: ass, ( word -- ) X , ; \ Wort compilieren, Lowbyte zuerst
: ass@ ( addr -- w ) X @ ; \ Wort holen
: ass@c ( addr -- w ) X c@ ; \ Byte holen
: ass! ( w addr -- ) X ! ; \ Wort schreiben
: ass!c ( w addr -- ) X c! ; \ Byte schreiben
\ Variablen ( 25.07.97/KK )
| Create mode 4 chars allot \ Adreßmode
| Variable offset \ Offsetwert für Opcode
| Variable komma \ Flag, ob Komma verwendet wurde
| Variable ssp \ Gespeicherte Stackposition
| Variable <ssp> \ Stacktiefe 1. Operand
| Create $tab &20 cells allot \ Tabelle mit Adressen
| : reset ( -- ) \ Setzt Flags zurück
mode 4 chars erase 0 offset ! 0 komma !
depth dup ssp ! <ssp> ! ;
: clearstack
depth <ssp> @ - dup 0>
IF 0 ?DO drop LOOP ELSE ABORT" stackschwund!" THEN ;
| : -reset? ( ... f -- -1 | ... 0 )
dup IF clearstack
reset true THEN ;
: ready ( -- ) \ Alle Assembler-Register zurücksetzen
reset $tab &20 cells erase ;
\ Tools ( 06.01.96/KK )
\ | : (aerror" ( flag -- )
\ -reset? IF r> $7fff error \ Fehler ausgeben
\ ELSE r> count 1+ + align >r THEN ; restrict
\ | : AError" ( string" ; f -- ) \ Assembler-Fehlerausgabe
\ compile (aerror" Ascii " $, ; immediate restrict
: AError" postpone -reset? postpone abort" ; immediate
| : mode@ ( -- n ) \ nur Lowbyte holen
mode c@ ;
| : mode! ( n -- ) \ Modus setzen
mode c! ;
| : +mode! ( n -- ) \ Wert zu MODE addieren
mode c@ + mode! ;
\ Tests ( 25.07.97/KK )
| : stack? ( -- n )
depth ssp @ - ;
| : ?arg ( n -- )
stack? 1- - Aerror" Falsche Anzahl von Argumenten" ;
| : ?mode0 ( -- ) \ Test, ob Mode $00
mode@ Aerror" Komma erwartet" ;
| : ?wreg ( -- ) \ Test auf Wortregister
mode@ $30 $20 within Aerror" Wortregister erwartet" ;
| : ?waddr ( addr -- ) \ Test auf Wortadresse
dup 1 and AError" Nur Wortadresse erlaubt" ;
| : ?baddr ( baddr -- bitoff )
?waddr
dup $fd00 $fe00 within IF $fd00 - u2/ exit THEN
dup $ff00 $ffe0 within IF $fe00 - u2/ exit THEN
-1 AError" Bitadresse erwartet" ;
| : ?rel ( addr -- rel ) \ 16Bit-Befehl erwartet
asshere X cell+ - X cell /
dup $80 $ff80 within AError" Relativsprungziel zu fern" ;
| : ?8b ( n -- n ) \ Test auf 8Bit-Wert
dup $ff u> AError" Datenbyte größer als 8 Bit" ;
| ' ?8b Alias ?seg \ Test auf Segment
| : ?page ( n -- n ) \ Test auf Page (10 Bit)
dup $3ff u> AError" Pagenummer größer als 10 Bit" ;
\ Registerdefinition (8Bit) ( 30.12.95/KK )
| : Rb: ( -- ; C: Reg -- ) \ Register definieren
Create $10 + dic,c
Does> c@ >r 0 ?arg ?mode0 \ Tests
r> +mode! ;
$00 Rb: rl0 $01 Rb: rh0 $02 Rb: rl1 $03 Rb: rh1
$04 Rb: rl2 $05 Rb: rh2 $06 Rb: rl3 $07 Rb: rh3
$08 Rb: rl4 $09 Rb: rh4 $0a Rb: rl5 $0b Rb: rh5
$0c Rb: rl6 $0d Rb: rh6 $0e Rb: rl7 $0f Rb: rh7
\ Registerdefinition (16Bit) ( 15.01.96/KK )
| : Rw: ( -- ; C: Reg -- ) \ Register definieren
Create $20 + dic,c
Does> c@ >r 0 ?arg ?mode0 \ Tests
r> +mode! ;
$00 Rw: r0 $01 Rw: r1 $02 Rw: r2 $03 Rw: r3
$04 Rw: r4 $05 Rw: r5 $06 Rw: r6 $07 Rw: r7
$08 Rw: r8 $09 Rw: r9 $0a Rw: r10 $0b Rw: r11
$0c Rw: r12 $0d Rw: r13 $0e Rw: r14 $0f Rw: r15
\ Adreßmodes ( 29.12.95/KK )
: ]+ ( -- ) \ Wortregister mit Postincrement
?wreg 0 ?arg $10 +mode! ;
: -] ( -- ) \ Wortregister mit Predecrement
?wreg 0 ?arg $20 +mode! ;
: ] ( -- ) \ Wortregister indirekt, evtl. Displacement
mode@ ?dup
IF $20 $30 within IF $30 +mode! exit THEN
ELSE stack? 1 = over 1 and 0= or IF $60 +mode! exit THEN
THEN -1 AError" Wortregister oder -adresse erwartet" ;
: #] ( -- ) \ Wortregister mit Displacement
?wreg 1 ?arg $50 +mode! ;
: s# ( data -- data ) \ Kurzwert
?mode0 1 ?arg $80 +mode! ;
: # ( data -- data ) \ Langwert
?mode0 1 ?arg $90 +mode! ;
: . ( data|wreg -- data ) \ Bitadresse
mode@ ?dup
IF dup $20 $30 within IF $d0 + $a0 mode! exit THEN
ELSE 1 ?arg ?baddr $a0 mode! exit
THEN -1 AError" Bitadresse erwartet" ;
\ Bedingungen ( 03.01.96/KK )
| : CC: ( -- ; C: cc -- ) \ Bedingungen definieren
Create $b0 + dic,c
Does> c@ >r 0 ?arg ?mode0 \ Tests
r> +mode! ;
$00 CC: cc_uc $01 CC: cc_net $02 CC: cc_z $02 CC: cc_eq
$03 CC: cc_nz $03 CC: cc_ne $04 CC: cc_v $05 CC: cc_nv
$06 CC: cc_n $07 CC: cc_nn $08 CC: cc_c $08 CC: cc_ult
$09 CC: cc_nc $09 CC: cc_uge $0a CC: cc_sgt $0b CC: cc_sle
$0c CC: cc_slt $0d CC: cc_sge $0e CC: cc_ugt $0f CC: cc_ule
\ Lokale Labels ( 30.12.95/KK )
| : $: ( -- ; C: # -- ) \ Adresse merken
Create 2 cells * cell+ dic,c
Does> c@ $tab +
dup @ AError" Label schon verwendet"
asshere swap ! ;
$00 $: 1$: $01 $: 2$: $02 $: 3$: $03 $: 4$:
$04 $: 5$: $05 $: 6$: $06 $: 7$: $07 $: 8$:
$08 $: 9$: $09 $: 10$:
| : $ ( -- ; C: # -- ) \ Referenz merken
Create $c0 + dic,c
Does> >r 0 ?arg ?mode0 r> c@ +mode! ;
$00 $ 1$ $01 $ 2$ $02 $ 3$ $03 $ 4$
$04 $ 5$ $05 $ 6$ $06 $ 7$ $07 $ 8$
$08 $ 9$ $09 $ 10$
: check ( -- ) \ teste $TAB
$tab &10 2* cells + $tab
DO i @ ?dup
IF i cell+ @ tuck 0= AError" Label nicht definiert"
BEGIN dup ass@ >r
over swap ass! r> ?dup 0=
UNTIL drop
THEN
4 +LOOP ready ;
\ Adreßmodes ( 01.01.96/KK )
: , ( -- ) \ Es folgt nächster Operand
komma @ 2 u> AError" Komma maximal zweimal erlaubt"
mode@ dup >r 0=
IF stack? 1- AError" Ein Operand erwartet"
ELSE r@ $60 u< r@ $af u> or
IF stack? AError" Kein Operand erlaubt" THEN
r@ $60 $a0 within
IF stack? 1- AError" Nur ein Operand erlaubt" THEN
r@ $a0 =
IF stack? 2 - AError" . erwartet Bitnummer"
dup $0f u> AError" Bitnummer ungültig" THEN
THEN mode 2 + c@ mode 3 + c! mode 1+ c@ mode 2 + c!
r> mode 1+ c! 0 mode!
1 komma +! depth ssp ! ;
\ Tools für Umsetzung ( 14.01.96/KK )
| : modes@ ( -- modes ) \ alle Modes holen
, stack? dup 4 0 within AError" Stacktiefe" 2* 2*
komma @ or
mode 3 + c@ $f0 and 8 lshift or
mode 2 + c@ $f0 and 4 lshift or
mode 1+ c@ $f0 and or ;
| : n@ ( -- m ) \ Register aus Mode+2 holen
mode 2 + c@ $0f and ;
| : n@<<4 ( -- $m0 ) \ Register ins High-Nibble
n@ 2* 2* 2* 2* ;
| : m@ ( -- n ) \ Register aus Mode+1 holen
mode 1+ c@ $0f and ;
| : o@ ( -- n ) \ Register aus Mode+2 holen
mode 3 + c@ $0f and ;
| : reg? ( addr -- addr 0 | reg -1 ) \ Test auf Register
dup 1 and IF 0 exit THEN \ Keine Wortadresse
dup $fe00 $ffe0 within IF $fe00 - u2/ -1 exit THEN
0 ;
| : ?reg ( addr -- reg )
reg? 0= AError" Register erwartet" ;
| : code, ( opcode -- ) \ Opcode mit Offset compilieren
offset @ + ass,c ;
| : codexx, ( opcode -- ) \ Achtung: Low/Highbyte vertauscht
offset @ + ass, ;
| : protect, ( opcode -- )
offset @ + dup ass,c dup invert ass,c dup ass,c ass,c ;
| : label, ( -- ) \ Label als letzter Operant
asshere m@ 2 cells * $tab + dup @ ass, ! ;
\ Umsetzung ( 18.03.96/KK )
| : w, ( opcode -- )
code, m@ $f0 + ass,c ;
| : w0, ( opcode -- ) \ Modus: Rw
code, m@ 2* 2* 2* 2* ass,c ;
| : ww, ( opcode -- ) \ Modus: Rw
code, m@ dup 2* 2* 2* 2* + ass,c ;
| : #d2, ( data offset -- ) \ Modus: data2 #
over 5 1 within AError" Nur 1..4 zulässig"
$d1 ass,c swap 1- 2* 2* 2* 2* + code, ;
| : w,w ( opcode -- ) \ Modus: Rw,Rw oder Rb,Rb
code, n@<<4 m@ + ass,c ;
| : -w,w code, m@ 2* 2* 2* 2* n@ + ass,c ;
| : w,w+d ( data opcode -- ) \ Modus: [Rw],[Rw+#data16]
w,w ass, ;
| : -w,w+d -w,w ass, ;
| : w,l ( label opcode -- )
code, n@ $f0 + ass,c label, ;
| : w,mem ( mem opcode -- ) \ Modus: Rw,mem
swap ?waddr swap code, n@ $f0 + ass,c ass, ;
| : w],mem ( mem opcode -- ) \ Modus: [Rw],mem
swap ?waddr swap code, n@ ass,c ass, ;
| : mem,w] ( mem opcode -- ) \ Modus: mem,[Rw]
swap ?waddr swap code, m@ ass,c ass, ;
| : b,bmem ( mem opcode -- ) \ Modus: Rb,mem
code, n@ $f0 + ass,c ass, ;
| : mem,w ( mem opcode -- ) \ Modus: mem,Rw
swap ?waddr swap code, m@ $f0 + ass,c ass, ;
| : bmem,b ( mem opcode -- ) \ Modus: mem,Rb
code, m@ $f0 + ass,c ass, ;
| : w,# ( data opcode -- ) \ Modus: Rw,#data16
code, n@ $f0 + ass,c ass, ;
| : w,#4 ( data4 opcode -- ) \ Modus: Rw,(s)#data4
over &15 u> AError" Nur 0..15 erlaubt"
code, 2* 2* 2* 2* n@ + ass,c ;
| : b,# ( data opcode -- ) \ Modus: Rb,#data8
swap ?8b swap w,# ;
| : reg,# ( reg data opcode -- ) \ Modus: reg,#data16
rot ?reg swap code, ass,c ass, ;
| : breg,# ( reg data opcode -- ) \ Modus: reg,#data8
swap ?8b swap reg,# ;
| : w,s# ( data3 opcode -- ) \ Modus: Rw,#data3
over 7 u> AError" Nur 0..7 erlaubt"
code, n@<<4 + ass,c ;
| : w,w] ( opcode -- ) \ Modus: Rw,[Rw] (Register<4)
m@ 3 u> AError" Nur Wortregister 0..3 erlaubt"
code, n@<<4 m@ $08 + + ass,c ;
| : w,w+] ( opcode -- ) \ Modus: Rw,[Rw+] (Register<4)
m@ 3 u> AError" Nur Wortregister 0..3 erlaubt"
code, n@<<4 m@ $0c + + ass,c ;
| : (r|bm,bm|r ( a1 a2 code offset -- ) \ Offset für mem,reg
>r >r swap reg?
IF r> code, rdrop ass,c ass, exit
ELSE swap reg?
IF r> r> + code, ass,c ass, exit THEN
rdrop rdrop drop drop
THEN -1 AError" Speicher zu Speicher nicht erlaubt" ;
| : r|bm,bm|r2 2 (r|bm,bm|r ;
| : r|bm,bm|r3 3 (r|bm,bm|r ;
| : r|bm,bm|r4 4 (r|bm,bm|r ;
| : reg,bmem ( reg mem code -- )
>r swap ?reg r> code, ass,c ass, ;
| : (r|m,m|r ( a1 a2 code offset -- ) \ Offset für mem,reg
>r >r swap reg?
IF swap ?waddr swap
r> code, rdrop ass,c ass, exit
ELSE swap reg?
IF swap ?waddr swap
r> r> + code, ass,c ass, exit THEN
rdrop rdrop drop drop
THEN -1 AError" Speicher zu Speicher nicht erlaubt" ;
| : r|m,m|r2 2 (r|m,m|r ;
| : r|m,m|r3 3 (r|m,m|r ;
| : r|m,m|r4 4 (r|m,m|r ;
| : reg,mem ( reg mem code -- )
swap ?waddr swap reg,bmem ;
| : bit, ( addr bit opcode -- )
swap 4 lshift + code, ass,c ;
| : bit,bit ( addr bit addr bit opcode -- )
code, 4 lshift >r ass,c swap ass,c r> or ass,c ;
| : ba_rel, ( baddr bit addr opcode -- )
swap ?waddr X cell - ?rel swap code,
rot ass,c ass,c 4 lshift ass,c ;
| : rmd, ( mask data opcode -- )
rot ?8b >r swap ?8b >r >r
r> code, o@ ass,c r> ass,c r> ass,c ;
| : amd, ( baddr mask data opcode -- )
rot ?8b >r swap ?8b >r >r ?baddr
r> code, ass,c r> ass,c r> ass,c ;
| : segaddr, ( seg addr opcode -- )
>r ?waddr swap ?8b r> code, ass,c ass, ;
| : ca_l, ( opcode -- )
code, n@<<4 ass,c label, ;
| : ca_a, ( addr opcode -- )
swap ?waddr swap code, n@<<4 ass,c ass, ;
| : ci_r, ( opcode -- )
code, n@<<4 m@ or ass,c ;
| : cr_a, ( addr opcode -- )
swap ?waddr ?rel swap code, ass,c ;
| : cs_a, ( seg addr opcode -- )
>r ?waddr swap ?seg r> code, ass,c ass, ;
| : $dc_#d2, ( data offset -- ) \ Modus: data2 #
over 5 1 within AError" Nur 1..4 zulässig"
$dc ass,c swap 1- 2* 2* 2* 2* + n@ + code, ;
| : $d7_#p_#d2, ( page data offset -- ) \ Modus: data2 #
>r >r ?page r> r> \ Test auf Page
over 5 1 within AError" Nur 1..4 zulässig"
$d7 ass,c swap 1- 2* 2* 2* 2* + code, ass, ;
| : $d7_#s_#d2, ( page data offset -- ) \ Modus: data2 #
>r >r ?8b r> r> \ Test auf Segment
over 5 1 within AError" Nur 1..4 zulässig"
$d7 ass,c swap 1- 2* 2* 2* 2* + code, ass, ;
| : reg, ( reg opcode -- )
swap ?reg swap code, ass,c ;
| : reg,l ( reg opcode -- )
reg, label, ;
| : $xd_rel, ( addr opcode -- )
swap ?waddr ?rel swap n@<<4 + code, ass,c ;
| : $yd_rel, ( addr opcode -- ) \ Bedingung negieren
n@ 2 u< AError" cc_UC und cc_NET nicht erlaubt"
swap ?waddr ?rel swap
n@ 1 xor 2* 2* 2* 2* + code, ass,c ;
| : trap7, ( addr opcode -- )
over $7f u> AError" Nur 0..127 erlaubt"
code, 2* ass,c ;
\ Generierung der Befehlstabellen ( 02.01.96/KK )
| : Table: ( Name ; -- addr )
Create here reset 0 dic,
Does> >r modes@ r@ @ r> cell+
?DO dup i @ = \ Adreßmodes gleich ?
IF drop i cell+ unloop dup @ swap \ code addr
cell+ perform reset exit THEN \ ausführen
6 +LOOP drop -1 AError" Adreßmode nicht erlaubt" ;
| : opc: ( routine ; ??? opcode -- )
>r modes@ dic, clearstack r> dic, ' dic, reset ;
| : ;Table ( addr -- ) \ Anzahl compilieren
here swap ! ;
| : +Table: ( Name ; cfa offset -- )
Create dic, dic,
Does> dup @ offset ! cell+ perform ;
| : 0Table: ( Name ; cfa opcode -- )
Create dic, dic,
Does> >r stack? mode@ or komma @ or
AError" Keine Parameter erwartet"
r@ @ r> cell+ perform ;
\ Opcodes (ohne Parameter) ( 06.01.96/KK )
' codexx, $00cc 0Table: nop,
' codexx, $00cb 0Table: ret,
' codexx, $88fb 0Table: reti,
' codexx, $00db 0Table: rets,
' protect, $a5 0Table: diswdt,
' protect, $b5 0Table: einit,
' protect, $87 0Table: idle,
' protect, $97 0Table: pwrdn,
' protect, $b7 0Table: srst,
' protect, $a7 0Table: srvwdt,
\ Opcodes (ein Parameter) ( 25.03.96/KK )
Table: atomic, 1 # $00 opc: #d2, ;Table
' atomic, $80 +Table: extr,
Table: cpl, r0 $91 opc: w0, ;Table
' cpl, $f0 +Table: neg,
Table: cplb, rl0 $b1 opc: w0, ;Table
' cplb, $f0 +Table: negb,
Table: push, ( -- )
r0 $ec opc: w,
0 $ec opc: reg,
;Table
' push, $10 +Table: pop,
' push, $ff +Table: retp,
\ Opcodes (Bitoperationen) ( 14.01.96/KK )
Table: bclr, r0 . 0 $0e opc: bit, ;Table
' bclr, $01 +Table: bset,
Table: band, r0 . 0 , r0 . 0 $6a opc: bit,bit ;Table
' band, $c0 +Table: bcmp,
' band, $e0 +Table: bmov,
' band, $d0 +Table: bmovn,
' band, $f0 +Table: bor,
' band, $10 +Table: bxor,
Table: bfldh,
r0 , 0 # , 0 # $1a opc: rmd,
0 , 0 # , 0 # $1a opc: amd,
;Table
' bfldh, $f0 +Table: bfldl,
\ Opcodes (Shift) ( 06.01.96/KK )
Table: ashr, ( -- )
r0 , r1 $AC opc: w,w
r0 , 1 # $BC opc: w,#4
;Table
' ashr, $a0 +Table: shl,
' ashr, $c0 +Table: shr,
' ashr, $60 +Table: rol,
' ashr, $80 +Table: ror,
Table: prior, r0 , r0 $2b opc: w,w ;Table
\ Opcodes (Division und Multiplikationen) ( 06.01.96/KK )
Table: div, r0 $4b opc: ww, ;Table
' div, $20 +Table: divl,
' div, $30 +Table: divlu,
' div, $10 +Table: divu,
Table: mul, r0 , r0 $0b opc: w,w ;Table
' mul, $10 +Table: mulu,
\ Opcodes (Call´s) ( 06.01.96/KK )
Table: calla,
cc_nc , 1$ $ca opc: ca_l,
cc_nc , 0 $ca opc: ca_a,
;Table
Table: calli, cc_nc , r0 ] $ab opc: ci_r, ;Table
Table: callr, 0 $bb opc: cr_a, ;Table
Table: calls, 0 , 0 $da opc: cs_a, ;Table
Table: pcall,
r0 , 1$ $e2 opc: w,l
r0 , 0 $e2 opc: w,mem
0 , 1$ $e2 opc: reg,l
0 , 0 $e2 opc: reg,mem
;Table
\ Opcodes (Jumps und TRAP) ( 06.01.96/KK )
Table: jb, r0 . 0 , 0 $8a opc: ba_rel, ;Table
' jb, $20 +Table: jbc,
' jb, $10 +Table: jnb,
' jb, $30 +Table: jnbs,
Table: jmpr, cc_nc , 0 $0d opc: $xd_rel, ;Table
| Table: -jmpr, cc_nc , 0 $0d opc: $yd_rel, ;Table
' calla, $20 +Table: jmpa,
' calli, $f1 +Table: jmpi,
Table: jmps, 0 , 0 $fa opc: segaddr, ;Table
Table: trap, 0 # $9b opc: trap7, ;Table
\ Opcodes (EXTS ... EXTPR) ( 14.01.96/KK )
Table: exts, ( -- )
r0 , 0 # $00 opc: $dc_#d2,
0 # , 0 # $00 opc: $d7_#s_#d2,
;Table
' exts, $80 +Table: extsr,
Table: extp, ( -- )
r0 , 0 # $40 opc: $dc_#d2,
0 # , 0 # $40 opc: $d7_#p_#d2,
;Table
' extp, $80 +Table: extpr,
\ Opcodes (ADD,-Type) ( 06.01.96/KK )
Table: add, ( -- )
r0 , r0 $00 opc: w,w
r0 , 0 $02 opc: w,mem
0 , 0 $02 opc: r|m,m|r2
0 , r0 $04 opc: mem,w
r0 , 0 # $06 opc: w,#
$fe00 , 0 # $06 opc: reg,#
r0 , r0 ] $08 opc: w,w]
r0 , r0 ]+ $08 opc: w,w+]
r0 , 0 s# $08 opc: w,s#
;Table
' add, $10 +Table: addc, ' add, $20 +Table: sub,
' add, $30 +Table: subc, ' add, $50 +Table: xor,
' add, $60 +Table: and, ' add, $70 +Table: or,
\ Opcodes (ADDB-Types) ( 06.01.96/KK )
Table: addb, ( -- )
rl0 , rl0 $01 opc: w,w
rl0 , 0 $03 opc: b,bmem
0 , 0 $03 opc: r|bm,bm|r2
0 , rl0 $05 opc: bmem,b
rl0 , 0 # $07 opc: b,#
$fe00 , 0 # $07 opc: breg,#
rl0 , r0 ] $09 opc: w,w]
rl0 , r0 ]+ $09 opc: w,w+]
rl0 , 0 s# $09 opc: w,s#
;Table
' addb, $10 +Table: addbc, ' addb, $20 +Table: subb,
' addb, $30 +Table: subbc, ' addb, $50 +Table: xorb,
' addb, $60 +Table: andb, ' addb, $70 +Table: orb,
\ Opcodes (CMP) ( 06.01.96/KK )
Table: cmp, ( -- )
r0 , r0 $40 opc: w,w
r0 , 0 $42 opc: w,mem
$fe00 , 0 $42 opc: reg,mem
r0 , 0 # $46 opc: w,#
$fe00 , 0 # $46 opc: reg,#
r0 , r0 ] $48 opc: w,w]
r0 , r0 ]+ $48 opc: w,w+]
r0 , 0 s# $48 opc: w,s#
;Table
\ Opcodes (CMPB) ( 06.01.96/KK )
Table: cmpb, ( -- )
rl0 , rl0 $41 opc: w,w
rl0 , 0 $43 opc: b,bmem
$fe00 , 0 $43 opc: reg,bmem
rl0 , 0 # $47 opc: b,#
$fe00 , 0 # $47 opc: breg,#
rl0 , r0 ] $49 opc: w,w]
rl0 , r0 ]+ $49 opc: w,w+]
rl0 , 0 s# $49 opc: w,s#
;Table
\ Opcodes (CMPD1 ... CMPI2) ( 06.01.96/KK )
Table: cmpd1, ( -- )
r0 , 0 s# $a0 opc: w,#4
r0 , 0 $a2 opc: w,mem
r0 , 0 # $a6 opc: w,#
;Table
' cmpd1, $10 +Table: cmpd2,
' cmpd1, $e0 +Table: cmpi1,
' cmpd1, $f0 +Table: cmpi2,
\ Opcodes (MOV) ( 18.03.96/KK )
Table: mov, ( -- )
r0 , r0 $f0 opc: w,w
r0 , 0 s# $e0 opc: w,#4
r0 , 0 # $e6 opc: w,#
$fe00 , 0 # $e6 opc: reg,#
r0 , r0 ] $a8 opc: w,w
r0 , r0 ]+ $98 opc: w,w
r0 ] , r0 $b8 opc: -w,w
r0 -] , r0 $88 opc: -w,w
r0 ] , r0 ] $c8 opc: w,w
r0 ]+ , r0 ] $d8 opc: w,w
r0 ] , r0 ]+ $e8 opc: w,w
r0 , r0 0 #] $d4 opc: w,w+d
r0 0 #] , r0 $c4 opc: -w,w+d
r0 ] , 0 $84 opc: w],mem
0 , r0 ] $94 opc: mem,w]
r0 , 0 $f2 opc: w,mem
0 , 0 $f2 opc: r|m,m|r4
0 , r0 $f6 opc: mem,w
;Table
\ Opcodes (MOVB) ( 18.03.96/KK )
Table: movb, ( -- )
rl0 , rl0 $f1 opc: w,w
rl0 , 0 s# $e1 opc: w,#4
rl0 , 0 # $e7 opc: b,#
$fe00 , 0 # $e7 opc: breg,#
rl0 , r0 ] $a9 opc: w,w
rl0 , r0 ]+ $99 opc: w,w
r0 ] , rl0 $b9 opc: -w,w
r0 -] , rl0 $89 opc: -w,w
r0 ] , r0 ] $c9 opc: w,w
r0 ]+ , r0 ] $d9 opc: w,w
r0 ] , r0 ]+ $e9 opc: w,w
rl0 , r0 0 #] $f4 opc: w,w+d
r0 0 #] , rl0 $e4 opc: -w,w+d
r0 ] , 0 $a4 opc: w],mem
0 , r0 ] $b4 opc: mem,w]
rl0 , 0 $f3 opc: b,bmem
0 , 0 $f3 opc: r|bm,bm|r4
0 , rl0 $f7 opc: bmem,b
;Table
\ Opcodes (MOVBS MOVBZ SCXT) ( 14.01.96/KK )
Table: movbs, ( -- )
r0 , rl0 $d0 opc: w,w
r0 , 0 $d2 opc: b,bmem
0 , 0 $d2 opc: r|m,m|r3
0 , rl0 $d5 opc: bmem,b
;Table
' movbs, $f0 +Table: movbz,
Table: scxt, ( -- )
r0 , 0 # $c6 opc: w,#
$fe00 , 0 # $c6 opc: reg,#
r0 , 0 $d6 opc: w,mem
0 , 0 $d6 opc: reg,mem
;Table
\ Zusätze für Kontrollstrukturen ( 25.07.97/KK )
| : >jrcc ( -- ) \ JMPR mit Bedingung compilieren
, asshere X cell+ -jmpr, ;
| : <jrcc ( addr flag -- addr flag )
, over -jmpr, ;
| : -?rel ( addr -- rel ) \ 16Bit-Befehl erwartet
asshere swap - X cell /
dup $80 $ff80 within AError" Relativsprungziel zu fern" ;
| : >jrres ( addr -- )
dup -?rel swap 1- ass!c ;
| : >jrresume ( 2 [ addr -2 ] -- )
BEGIN -2 = WHILE >jrres REPEAT reset ;
: ?pairs - ABORT" C165: unstructured!" ;
\ Kontrollstrukturen ( 06.01.96/KK )
: IF, ( -- addr 1 ) \ Bedingung erwartet
>jrcc asshere 1 reset ;
: ELSE, ( addr 1 -- addr2 -1 ) \ Nichts vorher erlaubt
dup 1 ?pairs \ Test
cc_UC , asshere X cell+ jmpr, \ unbedingter Vorwärtssprung
drop >jrres \ IF, auflösen
asshere -1 reset ; \ Flags/Adresse für THEN,
: THEN, ( addr 1|addr2 -1 -- )
dup abs 1 ?pairs
drop >jrres reset ;
: BEGIN, ( -- 2 addr 2 )
2 asshere 2 reset ;
: WHILE, ( addr 2 -- addr2 -2 addr 2 )
dup 2 ?pairs
>jrcc asshere -2 2swap reset ;
: REPEAT, ( 2 [ addr2 -2 ] addr 2 -- )
dup 2 ?pairs
drop >r depth 2 + ssp ! cc_UC , r> jmpr,
>jrresume ;
: UNTIL, ( 2 [ addr2 -2 ] addr 2 -- )
dup 2 ?pairs <jrcc 2drop >jrresume ;
\ Register des 80C165 ( 03.02.96/KK )
$f108 Constant _rp0h \ System Startup Conf. R.
$ff12 Constant _syscon \ CPU System Conf. R.
$ff10 Constant _psw \ CPU Program Status Word
$fe10 Constant _cp \ CPU Context Ptr R.
$ffae Constant _wdtcon \ Watchdog Timer C.R.
$feae Constant _wdt \ Watchdog Timer R.
$f1c0 Constant _exicon \ External Interrupt C.R.
$f186 Constant _xp0ic \ X-Peripheral 0 Interrupt C.R.
$f18e Constant _xp1ic \ X-Peripheral 1 Interrupt C.R.
$f196 Constant _xp2ic \ X-Peripheral 2 Interrupt C.R.
$f19e Constant _xp3ic \ X-Peripheral 3 Interrupt C.R.
$ffac Constant _tfr \ Trap Flag R.
\ Register des 80C165 (Stack, Page Ptr) ( 03.02.96/KK )
$fe12 Constant _sp \ CPU System Stack Ptr R.
$fe14 Constant _stkov \ CPU Stack Overflow Ptr R.
$fe16 Constant _stkun \ CPU Stack Underflow Ptr R.
$fe08 Constant _csp \ CPU Code Segment Ptr R.
$fe00 Constant _dpp0 \ CPU Data Page Ptr 0 R.
$fe02 Constant _dpp1 \ CPU Data Page Ptr 1 R.
$fe04 Constant _dpp2 \ CPU Data Page Ptr 2 R.
$fe06 Constant _dpp3 \ CPU Data Page Ptr 3 R.
\ Register des 80C165 (PEC, 0, -1, MD) ( 03.02.96/KK )
$fec0 Constant _pecc0 \ PEC Channel 0 C.R.
$fec2 Constant _pecc1 \ PEC Channel 1 C.R.
$fec4 Constant _pecc2 \ PEC Channel 2 C.R.
$fec6 Constant _pecc3 \ PEC Channel 3 C.R.
$fec8 Constant _pecc4 \ PEC Channel 4 C.R.
$feca Constant _pecc5 \ PEC Channel 5 C.R.
$fecc Constant _pecc6 \ PEC Channel 6 C.R.
$fece Constant _pecc7 \ PEC Channel 7 C.R.
$ff1c Constant _zeros \ Constant 0
$ff1e Constant _ones \ Constant $ffff
$ff0e Constant _mdc \ CPU Multiply Divide C.R.
$fe0c Constant _mdh \ CPU Multiply Divide R. (High)
$fe0e Constant _mdl \ CPU Multiply Divide R. (Low)
\ Register des 80C165 ( 03.02.96/KK )
$ff0c Constant _buscon0 \ Bus Configuration R. 0
$ff14 Constant _buscon1 \ Bus Conf. R. 1
$ff16 Constant _buscon2 \ Bus Conf. R. 2
$ff18 Constant _buscon3 \ Bus Conf. R. 3
$ff1a Constant _buscon4 \ Bus Conf. R. 4
$fe18 Constant _addrsel1 \ Adress Select R. 1
$fe1a Constant _addrsel2 \ Adress Select R. 2
$fe1c Constant _addrsel3 \ Adress Select R. 3
$fe1e Constant _addrsel4 \ Adress Select R. 4
$fe4a Constant _caprel \ GPT1 Capture/Reload R.
$ff6a Constant _cric \ GPT2 CAPREL Interrupt C.R.
\ Register des 80C165 (Timer) ( 03.02.96/KK )
$ff40 Constant _t2con \ GPT1 Timer 2 C.R.
$ff42 Constant _t3con \ GPT1 Timer 3 C.R.
$ff44 Constant _t4con \ GPT1 Timer 4 C.R.
$ff46 Constant _t5con \ GPT2 Timer 5 C.R.
$ff48 Constant _t6con \ GPT2 Timer 6 C.R.
$ff60 Constant _t2ic \ GPT1 Timer 2 Interrupt C.R.
$ff62 Constant _t3ic \ GPT1 Timer 3 Interrupt C.R.
$ff64 Constant _t4ic \ GPT1 Timer 4 Interrupt C.R.
$ff66 Constant _t5ic \ GPT2 Timer 5 Interrupt C.R.
$ff68 Constant _t6ic \ GPT2 Timer 6 Interrupt C.R.
$fe40 Constant _t2 \ GPT1 Timer 2 R.
$fe42 Constant _t3 \ GPT1 Timer 3 R.
$fe44 Constant _t4 \ GPT1 Timer 4 R.
$fe46 Constant _t5 \ GPT1 Timer 5 R.
$fe48 Constant _t6 \ GPT1 Timer 6 R.
\ Register des 80C165 (Ports) ( 03.02.96/KK )
$f100 Constant _dp0l \ P0L Direction Control Register
$ff00 Constant _p0l \ Port 0 Low R.
$f102 Constant _dp0h \ P0H Direction C.R.
$ff02 Constant _p0h \ Port 0 High R.
$f104 Constant _dp1l \ P1L Direction C.R.
$ff04 Constant _p1l \ Port 1 Low R.
$f106 Constant _dp1h \ P1H Direction C.R.
$ff06 Constant _p1h \ Port 1 High R.
$ffc2 Constant _dp2 \ Port 2 Direction C.R.
$f1c2 Constant _odp2 \ Port 2 Open Drain C.R
$ffc0 Constant _p2 \ Port 2 R.
$ffc6 Constant _dp3 \ Port 3 Direction C.R.
$f1c6 Constant _odp3 \ Port 3 Open Drain C.R
$ffc4 Constant _p3 \ Port 3 R.
$ffca Constant _dp4 \ Port 4 Direction C.R.
$ffc8 Constant _p4 \ Port 4 R. (8 Bit)
$ffa2 Constant _p5 \ Port 5 R.
$ffce Constant _dp6 \ Port 6 Direction C.R.
$f1ce Constant _odp6 \ Port 6 Open Drain C.R
$ffcc Constant _p6 \ Port 6 R. (8 Bit)
\ Register des 80C165 (SC0 und SCC) ( 03.02.96/KK )
$feb0 Constant _s0tbuf \ SC0 TX Data
$feb2 Constant _s0rbuf \ SC0 RX Data
$feb4 Constant _s0bg \ SC0 Baud Rate Generator Reload
$f19c Constant _s0tbic \ SC0 TX Interrupt C.R.
$ff6c Constant _s0tic \ SC0 TX Interrupt C.R.
$ff6e Constant _s0ric \ SC0 RX Interrupt C.R.
$ff70 Constant _s0eic \ SC0 Error Interrupt C.R.
$ffb0 Constant _s0con \ SC0 C.R.
$f0b0 Constant _ssctb \ SSC Transmit Buffer
$f0b2 Constant _sscrb \ SSC Receive Buffer
$f0b4 Constant _sscbr \ SSC Baudrate Register
$ff72 Constant _ssctic \ SSC TX Interrupt C.R.
$ff74 Constant _sscric \ SSC RX Interrupt C.R.
$ff76 Constant _ssceic \ SSC Error Interrupt C.R.
$ffb2 Constant _ssccon \ SSC C.R.
\ End-Proc End-Code ( 02.01.96/KK )
\ : End-Proc ( -- )
\ check reveal Forth ;
\ : End-Code ( -- )
\ [compile] end-proc ;
\ ;Code Proc Code ( 25.07.97/KK )
\ forth definitions
\ : ;Code ( 0 -- )
\ dup 0 ?pairs drop
\ compile (;code [compile] [
\ [Assembler] ready [Forth] Assembler ; immediate
\ : Proc ( name ; -- )
\ Create hide
\ [Assembler] ready [Forth] Assembler ;
: (Code)-c165 ( name ; -- )
(code)-1 ready ; ' (code)-c165 IS (code)
: (end-code)-c165
check (end-code)-1 ;
previous definitions
\ Beschreibung der Adreßmodes ( 25.07.97/KK )
\ mode -> $00xx : Nur ein Operant (kein Komma)
\ $xxyy : xx=1. Mode ; yy=2. Mode
\
\ Mode Stack Typ Mode Stack Typ
\ $00 0/1 --- $1n 0 Byteregister
\ $2n 0 Wortregister $3n 0 [Wortregister+]
\ $4n 0 [-Wortregister] $5n 0 [Wortregister]
\ $60 1 [Memory] $7n 1 [Rw+d]
\ $80 1 3Bit-Wert $90 1 Wert
\ $A0 2 Bitadresse $Bc 0 Bedingung
\ $Cn 0 Label
\ -------------------------------------------------------------
\ Logbuch ( 25.07.97/KK )
\
\ 27.12.95 KK: File angefangen
\ 06.01.95 KK: Assembler fertig
\ 03.02.96 KK: Register hinzugefügt
\ 12.02.96 KK: Korrektur in JB, (Sprung+2) und 0Table:
\ 18.03.96 KK: IP auf Register R3 gelegt (wegen BRANCH)
\ Korrekturen in MOV, und MOVB, (n<>m)
\ 25.03.96 KK: POP korrigiert (Offset $10 statt $6B)
\ w,w] korrigiert ($08 statt $04 addieren)
\ 04.01.96 KK: Opcode für JMPS korrigiert
\ 12.02.96 KK: Korrekturen
\ 25.07.97 KK: Anpassung an GFORTH (BLK->Seq.)
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>