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