[openfirmware] [commit] r2176 - cpu/arm forth/lib
repository service
svn at openfirmware.info
Thu Mar 3 07:14:41 CET 2011
Author: tooch
Date: Thu Mar 3 07:14:41 2011
New Revision: 2176
URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2176
Log:
ARM - Add sqrt, some FP, vector, ARMv7 instructions. Change trace on/off
trigger in armsim. Remove movw optimization in (set) -- it breaks ARMv4.
Modified:
cpu/arm/armsim.c
cpu/arm/assem.fth
cpu/arm/code.fth
cpu/arm/disassem.fth
cpu/arm/kerncode.fth
cpu/arm/kernel.bth
cpu/arm/sqroot.fth
forth/lib/loclabel.fth
Modified: cpu/arm/armsim.c
==============================================================================
--- cpu/arm/armsim.c Mon Feb 28 18:36:42 2011 (r2175)
+++ cpu/arm/armsim.c Thu Mar 3 07:14:41 2011 (r2176)
@@ -39,10 +39,10 @@
void regdump(u32 instruction, u32 last_pc, u8 cr)
{
- printf(" 0 %08x 1 %08x 2 %08x 3 %08x\n", r[0], r[1], r[2], r[3]);
- printf(" 4 %08x 5 %08x 6 %08x 7 %08x\n", r[4], r[5], r[6], r[7]);
- printf(" 8 %08x 9 %08x a %08x b %08x\n", r[8], r[9], r[10], r[11]);
- printf(" c %08x d %08x e %08x f %08x\n", r[12], r[13], r[14], r[15]);
+ printf(" r0 %08x r1 %08x r2 %08x r3 %08x\n", r[0], r[1], r[2], r[3]);
+ printf(" r4 %08x r5 %08x r6 %08x base %08x\n", r[4], r[5], r[6], r[7]);
+ printf(" r8 %08x up %08x tos %08x rp %08x\n", r[8], r[9], r[10], r[11]);
+ printf(" ip %08x sp %08x lr %08x pc %08x\n", r[12], r[13], r[14], r[15]);
printf("pc %08x lpc %08x i %08x ", PC - 8, last_pc, instruction);
if (cr)
putchar('\n');
@@ -800,8 +800,7 @@
case 0x11: INSTR("eor"); RD = RN ^ IMM32; UPCC(RD); break;
case 0x12: INSTR("sub"); SBB(RD, RN, IMM32, 1); break;
case 0x13: INSTR("rsb"); SBB(RD, IMM32, RN, 1); break;
-case 0x14: /* if (instruction == 0xe2809020) trace = 0; */
- INSTR("add"); ADC(RD, RN, IMM32, 0); break;
+case 0x14: INSTR("add"); ADC(RD, RN, IMM32, 0); break;
case 0x15: INSTR("adc"); ADC(RD, RN, IMM32, C); break;
case 0x16: INSTR("sbc"); SBB(RD, IMM32, RN, C); break;
case 0x17: INSTR("rsc"); SBB(RD, IMM32, RN, C); break;
@@ -810,9 +809,12 @@
case 0x0: INSTR("nop"); break;
case 0x1:
INSTR("wrc");
- if (RN == -2) {
+ if (UFIELD(19, 4) == 0xf) { // "wrc pc"
printf("Tracing on\n");
trace = 1;
+ } else if (UFIELD(19, 4) == 0xe) { // "wrc lr"
+ printf("Tracing off\n");
+ trace = 0;
} else if (RN == -1) {
// trace = 1;
// printf("find %x %x %x %x\n",r[2], r[1], r[0], r[3]);
Modified: cpu/arm/assem.fth
==============================================================================
--- cpu/arm/assem.fth Mon Feb 28 18:36:42 2011 (r2175)
+++ cpu/arm/assem.fth Thu Mar 3 07:14:41 2011 (r2176)
@@ -13,8 +13,8 @@
[then]
\needs land : land and ;
-\needs cindex fload ${BP}/forth/lib/parses1.fth
-\needs lex fload ${BP}/forth/lib/lex.fth
+\needs cindex fload ${BP}/forth/lib/parses1.fth
+\needs lex fload ${BP}/forth/lib/lex.fth
\needs 2nip : 2nip ( n1 n2 n3 n4 -- n3 n4 ) 2swap 2drop ;
vocabulary arm-assembler also arm-assembler definitions
@@ -149,7 +149,9 @@
next-cons constant adt-reg \ r0, r1, ..., pc.
next-cons constant adt-coreg \ c0, c1, ...
next-cons constant adt-coproc \ p0, p1, ...
-next-cons constant adt-xpsr \ cpsr, spsr.
+next-cons constant adt-dreg \ d0, d1, ...
+next-cons constant adt-sreg \ s0, s1, ...
+next-cons constant adt-xpsr \ cpsr, spsr, fpscr, ...
next-cons constant adt-shift \ Shift op in Shifter Operands.
next-cons constant adt-rrx
next-cons constant adt-immed \ #immediate_value.
@@ -240,6 +242,10 @@
rem$ " !#*+,-[]^_{}`" lex 0= if ( field$ )
0 0 2swap 0 ( rem$ field$ delim )
then ( rem$ field$ delim )
+ \ Horrible special case for L#
+ dup ascii # = 2over " l" $= and if
+ drop 1+ 0
+ then
is adr-delim 2swap set-rem$ ( field$ )
dup 0<> adr-delim or if ( field$ )
true ( field$ true )
@@ -268,6 +274,14 @@
: coreg: ( n "name" -- ) create , does> @ adt-coreg ;
: coregs: ( 10x"name" -- ) 10 0 do i coreg: loop ;
+\ Define the VFP/SIMD double-precision registers.
+: dreg: ( n "name" -- ) create , does> @ adt-dreg ;
+: dregs: ( 20x"name" -- ) 20 0 do i dreg: loop ;
+
+\ Define the VFP/SIMD single-precision registers.
+: sreg: ( n "name" -- ) create , does> @ adt-sreg ;
+: sregs: ( 20x"name" -- ) 20 0 do i sreg: loop ;
+
: range-error ( n msg$ -- ) type .d cr abort ;
: expecting ( $ -- ) ." Expecting " ad-error ;
@@ -388,7 +402,9 @@
r> set-field
;
-: ?register ( adt -- ) adt-reg <> " register" ?expecting ;
+: ?register ( adt -- ) adt-reg <> " register" ?expecting ;
+: ?dregister ( adt -- ) adt-dreg <> " dregister" ?expecting ;
+: ?sregister ( adt -- ) adt-sreg <> " sregister" ?expecting ;
: get-immediate ( -- n )
get-whatever adt-immed <> " immediate" ?expecting
@@ -413,6 +429,28 @@
: get-r12 ( -- ) d# 12 get-rn ;
: get-r16 ( -- ) d# 16 get-rn ;
+: ?dregister ( adt -- ) adt-dreg <> " doubleword register" ?expecting ;
+: get-dregister ( -- dreg )
+ require-field $asm-execute case
+ adt-sreg of 0000.0100 xop endof
+ adt-dreg of endof
+ " floating-point register" expecting
+ endcase
+;
+
+: set-vdfield ( n lo-D? -- )
+ \ Reg[5] is encoded as Vd[15-12]:D[22] OR as D[22]:Vd[15-12]. Sigh.
+ if
+ dup 1 and d# 22 lshift iop
+ 1 >> d# 12 lshift iop
+ else
+ dup h# 10 land d# 18 lshift iop
+ h# 0f land d# 12 lshift iop
+ then
+;
+: get-d12 ( -- ) get-dregister true set-vdfield ;
+
+
: expecting-reg/immed ( -- ) " register or immediate" expecting ;
: get-shiftr# ( -- )
\ Back over a real delimiter, then get the next thing.
@@ -539,6 +577,9 @@
!op
;
+: amode-vmrs ( -- ) init-operands get-r12 get-whatever ?psr iop !op ;
+: amode-vmsr ( -- ) init-operands get-whatever ?psr iop get-r12 !op ;
+
: (amode-mul) ( -- ) init-operands get-r16 get-r00 get-r08 ;
: amode-mul ( -- ) (amode-mul) !op ;
: amode-mla ( -- ) (amode-mul) get-r12 !op ;
@@ -600,7 +641,47 @@
!op
;
-\ rd, [rn, <immed12>] {!}
+: amode-vlsm ( need-r16? -- )
+ init-operands
+ if
+ get-r16 ( )
+ adr-delim ascii ! = if ( )
+ flip-w ( )
+ require-field " ," ?expecting drop ( )
+ then ( )
+
+ \ There should be a comma on the end of the register.
+ adr-delim ascii , <> " ," ?expecting
+ then
+
+ \ The next thing up should be an open brace for the register list.
+ get-whatever adt-delimiter <> " {" ?expecting
+ ascii { <> " {" ?expecting
+
+ \ Start with dreg-list "0, 0" and we'll update as we go along.
+ d# 32 0 ( first last )
+ begin adr-delim ascii } <> while
+ get-whatever case ( first last value adt )
+
+ adt-dreg of ( first last dreg )
+ \ Update first, last
+ tuck max -rot min swap ( first' last' )
+ \ Check the delimiter for - meaning a range.
+ adr-delim ascii - = if ( first' last' )
+ get-whatever ?dregister ( first' last' dreg )
+ max ( first' last'' )
+ then
+ endof
+
+ " register or }" expecting
+ endcase
+ repeat ( first last )
+
+ \ Encode the resulting Vd, imm8 fields
+ 1+ over - 2* iop false set-vdfield !op
+;
+
+\ rd, [rn, <immed12>] {!}
\ rd, [rn, +-rm] {!}
\ rd, [rn, +-rm, <shift>] {!}
\ rd, [rn], <immed12>
@@ -711,6 +792,27 @@
p? if {!} then
;
+: get-imm8 ( -- )
+ \ Get the offset for v[ldr|str] instructions
+ get-whatever case
+ adt-delimiter of
+ case
+ ascii + of get-r00 endof
+ ascii - of flip-u get-r00 endof
+ " +, -, or number" expecting
+ endcase
+ endof
+
+ adt-immed of
+ \ If the value is negative, switch things around.
+ dup 0< if negate flip-u then
+ d# 10 ?#bits 2 >>a iop
+ endof
+
+ " immediate value" expecting
+ endcase
+;
+
\ rd, [rn, <immed8>] {!}
\ rd, [rn, +-rm] {!}
\ rd, [rn], <immed8>
@@ -735,7 +837,6 @@
: amode-ldrex ( -- )
init-operands get-r12 ['] get-off0 get-ea !op
;
-
: amode-copr ( -- ) \ Co-processors: mcr, mrc
\ p, #, r, c, c, #
init-operands
@@ -778,6 +879,14 @@
!op
;
+: amode-vldst ( -- ) \ vldr, vstr instructions
+ init-operands
+ \ Set the add offset and 64-bit width as defaults.
+ 0080.0100 iop
+ get-d12 ['] get-imm8 get-ea
+ !op
+;
+
\ ----------------
: next-2? ( -- $ true | false )
@@ -843,11 +952,19 @@
: {cond/s} ( opcode -- ) {cond} {s} ;
: {uncond} ( opcode -- ) is newword ;
-: parse-inc ( l-flag -- )
- \ Parse the increment tag for ldm and stm. There MUST be a two letter
- \ code to specify the increment option so we bail if we don't get one
- \ of the eight possible codes. l-flag true specifies ldm, vice stm.
- 0= >r next-2? 0= " increment specifier" ?expecting
+: parse-inc ( default$ l-flag -- )
+ \ Parse the increment tag for ldm and stm.
+ \ If default is -1 then there MUST be a two letter code to specify
+ \ the increment option: we bail if we don't get one of the eight
+ \ possible codes. If default$ is non-null we'll use that instead
+ \ (see vldm et al.).
+ \ l-flag true specifies ldm, vice stm.
+ 0= >r
+ next-2? 0= if ( default$ )
+ ?dup 0= if drop true " increment specifier" ?expecting then
+ else ( default$ incr-spec$ )
+ 2swap 2drop
+ then
\ Correct tags have an even index from sindex.
" daiadbibfafdeaed" sindex dup 1 land " increment specifier" ?expecting
@@ -918,6 +1035,9 @@
: spsr ( -- n1 n2 ) 00400000 adt-xpsr ;
: cpsr ( -- n1 n2 ) 00000000 adt-xpsr ;
+: fpsid ( -- n1 n2 ) 00000000 adt-xpsr ;
+: fpscr ( -- n1 n2 ) 00010000 adt-xpsr ;
+: fpexc ( -- n1 n2 ) 00080000 adt-xpsr ;
psrs: _c _x _cx _s _cs _xs _cxs _f _cf _xf _cxf _sf _csf _xsf _cxsf
1 psr: _ctl
@@ -927,70 +1047,85 @@
coprocs: p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15
coregs: cr0 cr1 cr2 cr3 cr4 cr5 cr6 cr7 cr8 cr9 cr10 cr11 cr12 cr13 cr14 cr15
regs: r0 r1 r2 r3 r4 r5 r6 r7 r8 r9 r10 r11 r12 r13 r14 r15
+dregs: d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d18 d19 d20 d21 d22 d23 d24 d25 d26 d27 d28 d29 d30 d31
+sregs: s0 s1 s2 s3 s4 s5 s6 s7 s8 s9 s10 s11 s12 s13 s14 s15 s16 s17 s18 s19 s20 s21 s22 s23 s24 s25 s26 s27 s28 s29 s30 s31
previous definitions
also arm-assembler definitions
-: and 0000.0000 {cond/s} amode-rrop2 ;
-: eor 0020.0000 {cond/s} amode-rrop2 ;
-: sub 0040.0000 {cond/s} amode-rrop2 ;
-: rsb 0060.0000 {cond/s} amode-rrop2 ;
-: add 0080.0000 {cond/s} amode-rrop2 ;
-: adc 00a0.0000 {cond/s} amode-rrop2 ;
-: sbc 00c0.0000 {cond/s} amode-rrop2 ;
-: rsc 00e0.0000 {cond/s} amode-rrop2 ;
-: orr 0180.0000 {cond/s} amode-rrop2 ;
-: bic 01c0.0000 {cond/s} amode-rrop2 ;
-
-: clz 016f.0f10 {cond/s} amode-rdop2 ;
-: mov 01a0.0000 {cond/s} amode-rdop2 ;
-: mvn 01e0.0000 {cond/s} amode-rdop2 ;
-: movw 0300.0000 {cond} amode-movw ;
-
-: mul 0000.0090 {cond/s} amode-mul ;
-: mla 0020.0090 {cond/s} amode-mla ;
-: umull 0080.0090 {cond/s} amode-lmul ;
-: umlal 00a0.0090 {cond/s} amode-lmul ;
-: smull 00c0.0090 {cond/s} amode-lmul ;
-: smlal 00e0.0090 {cond/s} amode-lmul ;
-
-: tst 0110.0000 {cond} amode-rnop2 ;
-: teq 0130.0000 {cond} amode-rnop2 ;
-: cmp 0150.0000 {cond} amode-rnop2 ;
-: cmn 0170.0000 {cond} amode-rnop2 ;
-
-: mrs 010f.0000 {cond} amode-mrs ;
-: msr 0120.f000 {cond} amode-msr ;
-
-: ldc 0c10.0000 {cond} amode-lsc ;
-: stc 0c00.0000 {cond} amode-lsc ;
-: cdp 0e00.0000 {cond} amode-cdp ;
-: mcr 0e00.0010 {cond} amode-copr ;
-: mrc 0e10.0010 {cond} amode-copr ;
-
-: swi 0f00.0000 {cond} amode-imed24 ;
-
-: b 0a00.0000 {cond} amode-bbl ;
-: bl 0b00.0000 {cond} amode-bbl ;
-
-: bx 012f.ff10 {cond} amode-bx ;
-: blx 012f.ff30 {cond} amode-bx ;
-
-: swp 0100.0090 {cond} {b} amode-swp ;
-: strex 0180.0f90 {cond} {bh} amode-swp ;
-: ldrex 0190.0f9f {cond} {bh} amode-ldrex ;
-
-: ldm 0810.0000 {cond} 1 parse-inc 1 amode-lsm ;
-: popm 08bd.0000 {cond} 0 amode-lsm ;
-: stm 0800.0000 {cond} 0 parse-inc 1 amode-lsm ;
-: pushm 092d.0000 {cond} 0 amode-lsm ;
-
-: ldr ( -- ) 0410.0000 {cond} {shbt} ;
-: str ( -- ) 0400.0000 {cond} {hbt} ;
-
-: rev ( -- ) 06bf0f30 {cond} amode-rev ;
-: rev16 ( -- ) 06bf0fb0 {cond} amode-rev ;
-: revsh ( -- ) 06ff0f30 {cond} amode-rev ;
+: and 0000.0000 {cond/s} amode-rrop2 ;
+: eor 0020.0000 {cond/s} amode-rrop2 ;
+: sub 0040.0000 {cond/s} amode-rrop2 ;
+: rsb 0060.0000 {cond/s} amode-rrop2 ;
+: add 0080.0000 {cond/s} amode-rrop2 ;
+: adc 00a0.0000 {cond/s} amode-rrop2 ;
+: sbc 00c0.0000 {cond/s} amode-rrop2 ;
+: rsc 00e0.0000 {cond/s} amode-rrop2 ;
+: orr 0180.0000 {cond/s} amode-rrop2 ;
+: bic 01c0.0000 {cond/s} amode-rrop2 ;
+: uadd16 0650.0f10 {cond} amode-rrop2 ;
+: uasx 0650.0f30 {cond} amode-rrop2 ;
+: uadd8 0650.0f90 {cond} amode-rrop2 ;
+: uxtab 06e0.0070 {cond} amode-rrop2 ;
+
+: clz 016f.0f10 {cond/s} amode-rdop2 ;
+: mov 01a0.0000 {cond/s} amode-rdop2 ;
+: mvn 01e0.0000 {cond/s} amode-rdop2 ;
+: mvn 01e0.0000 {cond/s} amode-rdop2 ;
+
+: movw 0300.0000 {cond} amode-movw ;
+
+: mul 0000.0090 {cond/s} amode-mul ;
+: mla 0020.0090 {cond/s} amode-mla ;
+: umull 0080.0090 {cond/s} amode-lmul ;
+: umlal 00a0.0090 {cond/s} amode-lmul ;
+: smull 00c0.0090 {cond/s} amode-lmul ;
+: smlal 00e0.0090 {cond/s} amode-lmul ;
+
+: tst 0110.0000 {cond} amode-rnop2 ;
+: teq 0130.0000 {cond} amode-rnop2 ;
+: cmp 0150.0000 {cond} amode-rnop2 ;
+: cmn 0170.0000 {cond} amode-rnop2 ;
+
+: mrs 010f.0000 {cond} amode-mrs ;
+: msr 0120.f000 {cond} amode-msr ;
+
+: ldc 0c10.0000 {cond} amode-lsc ;
+: stc 0c00.0000 {cond} amode-lsc ;
+: cdp 0e00.0000 {cond} amode-cdp ;
+: mcr 0e00.0010 {cond} amode-copr ;
+: mrc 0e10.0010 {cond} amode-copr ;
+
+: swi 0f00.0000 {cond} amode-imed24 ;
+
+: b 0a00.0000 {cond} amode-bbl ;
+: bl 0b00.0000 {cond} amode-bbl ;
+
+: bx 012f.ff10 {cond} amode-bx ;
+: blx 012f.ff30 {cond} amode-bx ;
+
+: rev 06bf.0f30 {cond} amode-rev ;
+: rev16 06bf.0fb0 {cond} amode-rev ;
+: revsh 06ff.0f30 {cond} amode-rev ;
+
+: swp 0100.0090 {cond} {b} amode-swp ;
+: strex 0180.0f90 {cond} {bh} amode-swp ;
+: ldrex 0190.0f9f {cond} {bh} amode-ldrex ;
+
+: ldm 0810.0000 {cond} " " 1 parse-inc 1 amode-lsm ;
+: popm 08bd.0000 {cond} 0 amode-lsm ;
+: stm 0800.0000 {cond} " " 0 parse-inc 1 amode-lsm ;
+: pushm 092d.0000 {cond} 0 amode-lsm ;
+
+: ldr 0410.0000 {cond} {shbt} ;
+: str 0400.0000 {cond} {hbt} ;
+
+: vldr 0d10.0a00 {cond} amode-vldst ;
+: vstr 0d00.0a00 {cond} amode-vldst ;
+: vldm 0c10.0b00 {cond} " ia" 1 parse-inc 1 amode-vlsm ;
+: vstm 0c00.0b00 {cond} " ia" 0 parse-inc 1 amode-vlsm ;
+: vmsr 0ee0.0a10 {cond} amode-vmsr ;
+: vmrs 0ef0.0a10 {cond} amode-vmrs ;
: rd-field ( reg# -- ) d# 12 set-field ;
: rb-field ( reg# -- ) d# 16 set-field ;
@@ -1027,11 +1162,15 @@
true asm-const ( reg# op )
then
else ( reg# imm imm )
+[ifdef] armv7
0 1.0000 within if ( reg# imm )
set-imm16 0300.0000 ( reg# op ) \ movw rN,#<imm16>
else ( reg# imm )
false asm-const ( reg# op )
then
+[else]
+ drop false asm-const ( reg# op )
+[then]
then ( reg# op )
then ( reg# op )
iop rd-field !op
Modified: cpu/arm/code.fth
==============================================================================
--- cpu/arm/code.fth Mon Feb 28 18:36:42 2011 (r2175)
+++ cpu/arm/code.fth Thu Mar 3 07:14:41 2011 (r2176)
@@ -4,6 +4,10 @@
\ These words are specific to the virtual machine implementation
: assembler ( -- ) arm-assembler ;
+variable pre-asm-base
+: stash-base base @ pre-asm-base ! ;
+: restore-base pre-asm-base @ base ! ;
+
only forth also arm-assembler also helpers also arm-assembler also definitions
\ Forth Virtual Machine registers
@@ -54,6 +58,7 @@
: exitcode ( -- )
['] $interpret-do-undefined is $do-undefined
previous
+ restore-base
;
' exitcode is do-exitcode
headers
@@ -119,6 +124,8 @@
also forth definitions
headerless
: entercode ( -- )
+ stash-base
+ decimal
also assembler
\ false is disassembling?
[ also helpers ]
Modified: cpu/arm/disassem.fth
==============================================================================
--- cpu/arm/disassem.fth Mon Feb 28 18:36:42 2011 (r2175)
+++ cpu/arm/disassem.fth Thu Mar 3 07:14:41 2011 (r2176)
@@ -37,6 +37,21 @@
: forth-regs ['] (forth-regs is regs ;
forth-regs
+string-array dregs
+," d0" ," d1" ," d2" ," d3" ," d4" ," d5" ," d6" ," d7"
+," d8" ," d9" ," d10" ," d11" ," d12" ," d13" ," d14" ," d15"
+," d16" ," d17" ," d18" ," d19" ," d20" ," d21" ," d22" ," d23"
+," d24" ," d25" ," d26" ," d27" ," d28" ," d29" ," d30" ," d31"
+end-string-array
+
+string-array sregs
+," s0" ," s1" ," s2" ," s3" ," s4" ," s5" ," s6" ," s7"
+," s8" ," s9" ," s10" ," s11" ," s12" ," s13" ," s14" ," s15"
+," s16" ," s17" ," s18" ," s19" ," s20" ," s21" ," s22" ," s23"
+," s24" ," s25" ," s26" ," s27" ," s28" ," s29" ," s30" ," s31"
+end-string-array
+
+
: udis. ( n -- )
push-hex
<#
@@ -77,24 +92,40 @@
: ., ( -- ) ." , " ;
: .[ ( -- ) ." [" ;
: .] ( -- ) ." ]" ;
+: .{ ( -- ) ." {" ;
+: .} ( -- ) ." }" ;
: .rm ( -- ) 0 .reg ;
: .rs ( -- ) 8 .reg ;
-: .rd, ( -- ) d# 12 .reg ., ;
+: .rd ( -- ) d# 12 .reg ;
+: .rd, ( -- ) .rd ., ;
: op.rd, ( -- ) op-col .rd, ;
: .rb ( -- ) d# 16 .reg ;
alias .rn .rb
: rn ( -- rn ) d# 16 4bits ;
-: .rm,shift ( -- )
+: .rm,shift ( rsr? -- )
.rm
d# 4 8bits if \ LSL #0 is no-shift; this isn't it
.,
- 4 8bits 6 = if ." rrx" exit then
+ 4 8bits 6 = if ." rrx" drop exit then
5 2 " lsllsrasrror" 3 .fld ." "
- 4 bit? if .rs else ." #" 7 5 bits .d then
+ ( rsr? ) 4 bit? and if .rs else ." #" 7 5 bits .d then
+ else
+ drop
+ then
+;
+
+: get-vd ( dbit-lo? -- reg# )
+ if
+ d# 12 4bits 1 << d# 22 bit? if 1+ then
+ else
+ d# 12 4bits d# 22 bit? if h# 10 + then
then
;
+: .dreg ( reg# -- ) dregs ". ;
+: .sreg ( reg# -- ) sregs ". ;
+: op.vd, ( dbit-lo? -- ) op-col get-vd 8 bit? if .dreg else .sreg then ., ;
: u.h ( n -- ) dup d# 9 u> if ." 0x" then (u.) type ;
: ror ( n cnt -- ) 2dup d# 32 swap - lshift -rot rshift or ;
@@ -116,7 +147,7 @@
: +/- ( -- ) d#23 bit? 0= if ." -" then ;
: .r/imm ( -- )
- d#25 bit? if ." #" .imm else .rm,shift then
+ d#25 bit? if ." #" .imm else 1 .rm,shift then
;
\ Indicates the form of the instruction that affects both PC and CPSR/SPSR
: {p} ( -- )
@@ -278,7 +309,7 @@
\ : byte ( -- ) 00400000 op-or ; \ ldr str operate bytewide
: .mregs ( -- )
- ." {" ( )
+ .{ ( )
0 d# 16 bits false ( n need,? )
d# 16 0 do ( n need,? )
over 1 and if ( n need,? )
@@ -288,7 +319,7 @@
swap 2/ swap ( n need,?' )
loop ( n need,?' )
2drop ( )
- ." }" ( )
+ .} ( )
;
: .inc ( -- ) d#23 2 " daiadbib" 2 .fld ;
: .ldm/stm ( -- ) \ d# 25 3 bits 4 =
@@ -300,18 +331,25 @@
: imm12 ( -- n ) 0 d# 12 bits ;
: ,.addr-mode ( -- )
d#25 bit? if
- ., +/- .rm,shift
+ ., +/- 1 .rm,shift
else
imm12 if ., ." #" +/- imm12 u.h then
then
;
: .rev ( -- ) {<cond>} op.rd, .rm ;
+: .uadd ( -- ) {<cond>} op.rd, .rn ., .rm ;
+: .uxtab ( -- ) {<cond>} op.rd, .rn ., 0 .rm,shift ;
: .stuff ( -- )
- 0 d# 28 bits h# 0fff.0ff0 and
+ 0 d# 28 bits h# 0ff0.00f0 and
case
- h# 06bf0f30 of ." rev" .rev endof
- h# 06bf0fb0 of ." rev16" .rev endof
- h# 06ff0f30 of ." revsh" .rev endof
+ h# 0650.0090 of ." uadd8" .uadd endof
+ h# 0650.0010 of ." uadd16" .uadd endof
+ h# 0650.0030 of ." uasx" .uadd endof
+ h# 06b0.0030 of ." rev" .rev endof
+ h# 06b0.00b0 of ." rev16" .rev endof
+ h# 06e0.0070 of ." uxtab" .uxtab endof
+ h# 06f0.0030 of ." revsh" .rev endof
+ h# 06f0.0030 of ." revsh" .rev endof
( default )
." undefined" {<cond>}
endcase
@@ -348,10 +386,31 @@
10 8 fops rmf sin fml cos fdv tan frd asn
18 4 fops pol acs ??? atn
[then]
+: .fpspec ( -- )
+ d# 16 4bits case
+ 0 of ." fpsid" endof
+ 1 of ." fpscr" endof
+ 8 of ." fpexc" endof
+ ." fpxxx" endcase
+;
+
: p# ( -- n ) 8 4bits ;
: .p#, ( n -- ) ." p" p# n.d ., ;
: .offset8 ( -- ) ." #" +/- 0 8bits 4 * u.h ;
+: .vldst ( -- )
+ 24 bit? 21 bit? not and if
+ ." v" .ld/st ." r" {<cond>} true op.vd, .[ .rb
+ 0 8bits if ., .offset8 then .]
+ else
+ ." v" .ld/st ." m" {<cond>} .inc
+ op-col .rb {!} ., .{
+ false get-vd 0 8bits 2/ bounds over -rot do
+ i .dreg i 1+ over <> if ., then
+ loop drop .}
+ then
+;
: .ldc/stc ( -- )
+ 9 3 bits 5 = if .vldst exit then
.ld/st ." c" {<cond>} " l" d#22 ?.bit
op-col .p#, d# 12 .creg ., .[ .rn
p-bit if ., .offset8 .] {!} else .] ., .offset8 then
@@ -415,9 +474,19 @@
dup 7 8 between if drop ., .flushes exit then
d# 15 = if .clocks then \ SA-110
;
+: .vfp ( -- ) \ Decode VFP ops
+ d# 20 bit? if
+ ." vmrs" op.rd, .fpspec
+ else
+ ." vmsr" op-col .fpspec ., .rd
+ then
+;
+
: .coproc ( -- )
p-bit if .swi exit then
+
d# 4 bit? if \ MRC and MCR
+ p# 1 >> 5 = if .vfp exit then
d# 20 1 " mcrmrc" 3 .fld {<cond>}
op-col
p# d# 15 = if \ System Control Coprocessor
Modified: cpu/arm/kerncode.fth
==============================================================================
--- cpu/arm/kerncode.fth Mon Feb 28 18:36:42 2011 (r2175)
+++ cpu/arm/kerncode.fth Thu Mar 3 07:14:41 2011 (r2176)
@@ -753,6 +753,7 @@
: unaligned-l! ( l adr -- ) unaligned-! ;
: unaligned-d! ( d adr -- ) tuck na1+ unaligned-! unaligned-! ;
: d@ ( adr -- d ) dup @ swap na1+ @ ;
+: d! ( d adr -- ) tuck na1+ ! ! ;
code c! ( char adr -- ) pop r0,sp strb r0,[tos] pop tos,sp c;
code 2@ ( adr -- n-high n-low )
Modified: cpu/arm/kernel.bth
==============================================================================
--- cpu/arm/kernel.bth Mon Feb 28 18:36:42 2011 (r2175)
+++ cpu/arm/kernel.bth Thu Mar 3 07:14:41 2011 (r2176)
@@ -92,6 +92,7 @@
fload ${BP}/forth/kernel/uservars.fth
fload ${BP}/cpu/arm/muldiv.fth \ Uses "defer"; must be after uservars
+fload ${BP}/cpu/arm/sqroot.fth
fload ${BP}/cpu/arm/dodoesad.fth
fload ${BP}/cpu/arm/version.fth
Modified: cpu/arm/sqroot.fth
==============================================================================
--- cpu/arm/sqroot.fth Mon Feb 28 18:36:42 2011 (r2175)
+++ cpu/arm/sqroot.fth Thu Mar 3 07:14:41 2011 (r2176)
@@ -1,6 +1,7 @@
purpose: Integer square-root for ARM processors
\ See license at end of file
+0 [if]
\ u1 -- 32-bit unsigned
\ n -- significant digits
\ 16 -> sqrt-integer
@@ -26,6 +27,24 @@
top r1 mov c;
: sqrt ( u1 -- u2 ) td 16 (sqrt ;
+[then]
+
+\ 32bit -> 16bit fixed point square root
+\ see http://www.finesse.demon.co.uk/steven/sqrt.html
+code sqrt ( n -- root )
+ mov r0, tos \ n
+ mov tos, `1 d# 30 <<` \ root
+ mov r1, `3 d# 30 <<` \ offset
+ mov r2, 0 \ loop count
+ begin
+ cmp r0, tos, ror r2
+ subhs r0, r0, tos, ror r2
+ adc tos, r1, tos, lsl #1
+ inc r2, #2
+ cmp r2, #32
+ = until
+ bic tos, tos, `3 d# 30 <<`
+c;
\ LICENSE_BEGIN
\ Copyright (c) 2008 FirmWorks
Modified: forth/lib/loclabel.fth
==============================================================================
--- forth/lib/loclabel.fth Mon Feb 28 18:36:42 2011 (r2175)
+++ forth/lib/loclabel.fth Thu Mar 3 07:14:41 2011 (r2176)
@@ -17,7 +17,7 @@
headerless
20 constant #references-max
-10 constant #labels-max
+20 constant #labels-max
#labels-max #references-max * /n* buffer: references
#labels-max /n* buffer: local-labels
@@ -59,11 +59,12 @@
;
headerless
-: init-labels ( -- )
+: (init-labels) ( -- )
#labels-max 0 do i clear-label loop
;
-init-labels
+defer init-labels
+' (init-labels) is init-labels
also forth definitions
headers
More information about the openfirmware
mailing list