[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