Author: tooch Date: Tue Apr 5 21:48:04 2011 New Revision: 2183 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2183
Log: ARM Simulator - Fix the incredibly buggy shift logic.
ARM Assembler - Re-enhance (set) for ARMv6/v7...use movw/movt pairs.
ARM/Darwin - Use a make target that will compile the inflater under Xtools.
General - Add $case/$of/$endof/$endcase words yielding a case statement that uses a string as a selector vice an integer.
Added: cpu/arm/Darwin/ cpu/arm/Darwin/Makefile forth/lib/strcase.fth Modified: cpu/arm/armsim.c cpu/arm/assem.fth cpu/arm/build/Makefile cpu/arm/disassem.fth cpu/arm/kerncode.fth cpu/x86/kerncode.fth forth/lib/build.sh forth/lib/decomp.fth forth/lib/loadcomm.fth
Added: cpu/arm/Darwin/Makefile ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ cpu/arm/Darwin/Makefile Tue Apr 5 21:48:04 2011 (r2183) @@ -0,0 +1,25 @@ +# Darwin ARM tools + +BP = ../../.. +ZIPDIR = ${BP}/forth/wrapper/zip + +# Rationale for these flags: +# -Oz optimizes for smallest possible size. (Apple-specific) +# -fno-toplevel-reorder keeps inflate() as the first entry point. +# -thumb gives 30%-50% improvement over ARM32. +# -arch armv7 uses more powerful instructions for less space. +# -static -nostartfiles allows us to link this as a static text image. +# This set of flags generates an inflate.bin of 3546 bytes. + +CFLAGS = -Oz -arch armv7 -mthumb -static -nostartfiles -fno-toplevel-reorder + +INFLATEBIN = ../build/inflate.bin + +$(INFLATEBIN): inflate + segedit $< -extract __TEXT __text $@ + +inflate: ${ZIPDIR}/inflate.c + ${CC} ${CFLAGS} -o $@ $< + +clean: + rm -f *.o inflate $(INFLATEBIN)
Modified: cpu/arm/armsim.c ============================================================================== --- cpu/arm/armsim.c Tue Apr 5 17:13:03 2011 (r2182) +++ cpu/arm/armsim.c Tue Apr 5 21:48:04 2011 (r2183) @@ -82,19 +82,100 @@ struct { signed int imm24:24; } sext24; #define BTGT { PC += sext24.imm24 = (IMM24 << 2); last_pc = 1; }
+int scout; // Hold the last bit shifted out #define ROTATE(imm, rot) (((imm) >> (rot)) | ((imm) << (32-(rot)))) #define IMM32 ROTATE(IMM8, (ROT<<1))
-#define SHSRC (OP1 ? RS : IMM5) -#define SHFT(res) \ -{ \ - switch (TYPE) { \ - case 0: res = RM << SHSRC; break; \ - case 1: res = RM >> SHSRC; break; \ - case 2: if (SHSRC == 0) { res = ((s32)(RM) < 0) ? -1 : 0; } else { res = (s32)(RM) >> SHSRC; } break; \ - case 3: res = ROTATE(RM, SHSRC); \ - } \ +#define TEST_SHIFT 0 +#if defined(TEST_SHIFT) && TEST_SHIFT +#define EXIT(r) goto exit +#else +#define EXIT(r) return res +#endif + +u32 shifter(u32 rm, u32 rs, u32 type, u32 imm, u32 imm5, u32 cin, u32 pc, u32 ir) +{ + u32 res, res2; + int cnt; + +#if defined(TEST_SHIFT) && TEST_SHIFT + u32 res2; + cnt = imm ? imm5 : rs; + switch (type) { + case 0: res = rm << cnt; break; + case 1: res = rm >> cnt; break; + case 2: if (cnt == 0) { res = ((s32)(rm) < 0) ? -1 : 0; } else { res = (s32)(rm) >> cnt; } break; + case 3: res = ROTATE(rm, cnt); + } + res2 = res; +#endif + + if (imm && (imm5 == 0)) { + if (type == 0) { + res = rm; + scout = cin; + EXIT(res); + return res; + } + + if (type == 2) { + if ((s32)rm < 0) res = -1; + else res = 0; + scout = res & 1; + EXIT(res); + return res; + } + + if (type == 3) { + res = (cin << 31) | (rm >> 1); + scout = rm & 1; + EXIT(res); + return res; + } + } + + if (imm) { + if (imm5 == 0) cnt = 32; + else cnt = imm5; + } else cnt = rs & 31; + + if (cnt == 0) { + res = rm; + scout = cin; + EXIT(res); + return res; + } + + switch (type) { + case 0: res = rm << cnt; scout = rm >> (32 - cnt); break; + case 1: res = rm >> cnt; scout = rm >> (cnt - 1); break; + case 2: res = (s32)rm >> cnt; scout = rm >> (cnt - 1); break; + case 3: res = ROTATE(rm, cnt); scout = res >> 31; + } /* switch */ + + scout &= 1; + + EXIT(res); + +#if defined(TEST_SHIFT) && TEST_SHIFT +exit: + if (res != res2) { + char *shifts[] = {"lsl", "lsr", "asr", "ror"}; + printf("PC: %x: %x ", pc, ir); + if (imm) { + printf("imm = #%d", imm5); + } else { + printf("RS = %d", rs & 31); + } + printf(", RM = %x, %s #%d; res = %x, res2 = %x\n", rm, shifts[type], cnt, res, res2); +// while (1); + } + return res; +#endif } + + +#define SHFT(res) res = shifter(RM, RS, TYPE, !OP1, IMM5, C, PC, instruction)
#define BF(sb, eb) ((u32)(((s32)0x80000000) >> (sb - eb))) >> (31 - sb);
@@ -122,7 +203,16 @@ if (S) { \ N = (res) >> 31; \ Z = (res == 0); \ -/* FIXME - possible problem with C bit - should be set to carry output from shifter */ \ + } \ +} + +/* Factor in the shifted-out Carry. */ +#define SHFT_UPCC(res) \ +{ \ + if (S) { \ + N = (res) >> 31; \ + Z = (res == 0); \ + C = scout ? 1 : 0; \ } \ }
@@ -152,7 +242,7 @@
#define UNIMP(s) \ { \ - printf("UNIMPLEMENTED '%s' op %02x s %d bxtype %02x\n", s, OP, S, BXTYPE); \ + printf("UNIMPLEMENTED '%s' op %02x s %d bxtype %02x; Source line: %d\n", s, OP, S, BXTYPE, __LINE__); \ regdump(instruction, last_pc, 1); \ return; \ } @@ -257,7 +347,7 @@ UNIMP("unconditional"); switch (OP) { case 0x00: if (OP1 == 0 || OP2 == 0) { - INSTR("and"); SHFT(res); RD = RN & res; UPCC(RD); break; + INSTR("and"); SHFT(res); RD = RN & res; SHFT_UPCC(RD); break; } switch (BXTYPE) { case 0x9: INSTR("mul"); RN = RS * RM; UPCC(RN); break; @@ -293,7 +383,7 @@ default: UNIMP("BXTYPE"); break; } break; case 0x01: if (OP1 == 0 || OP2 == 0) { - INSTR("eor"); SHFT(res); RD = RN ^ res; UPCC(RD); break; + INSTR("eor"); SHFT(res); RD = RN ^ res; SHFT_UPCC(RD); break; } switch (BXTYPE) { case 0x9: UNIMP("mla"); break; @@ -628,13 +718,13 @@ default: UNIMP("BXTYPE"); break; } break; case 0x0c: if (OP1 == 0 || OP2 == 0) { - INSTR("orr"); SHFT(res); RD = RN | res; UPCC(res); break; + INSTR("orr"); SHFT(res); RD = RN | res; SHFT_UPCC(RD); } else { switch (BXTYPE) { case 0x1: case 0x3: case 0x5: - case 0x7: INSTR("orr"); SHFT(res); RD = RN | res; UPCC(res); + case 0x7: INSTR("orr"); SHFT(res); RD = RN | res; SHFT_UPCC(RD); break; case 0x9: UNIMP("ldrex"); break; // P=1, U=0, bit22=0, W=0 - offset/pre-index, subtract offset, register, no writeback @@ -678,16 +768,16 @@ RD = RM; UPCC(RD); break; } /* else fall through */ case 0x8: - case 0x1: INSTR("lsl"); SHFT(RD); UPCC(RD); break; + case 0x1: INSTR("lsl"); SHFT(RD); SHFT_UPCC(RD); break; case 0x2: case 0xa: - case 0x3: INSTR("lsr"); SHFT(RD); UPCC(RD); break; + case 0x3: INSTR("lsr"); SHFT(RD); SHFT_UPCC(RD); break; case 0x4: case 0xc: - case 0x5: INSTR("asr"); SHFT(RD); UPCC(RD); break; + case 0x5: INSTR("asr"); SHFT(RD); SHFT_UPCC(RD); break; case 0x6: case 0xe: - case 0x7: INSTR("ror"); SHFT(RD); UPCC(RD); break; + case 0x7: INSTR("ror"); SHFT(RD); SHFT_UPCC(RD); break; case 0x9: UNIMP("ldrexd"); break; // P=1, U=1, bit22=0, W=1 - offset/pre-index, add offset, register, writeback case 0xb: @@ -725,7 +815,7 @@ default: UNIMP("BXTYPE"); break; }; break; case 0x0e: if (OP1 == 0 || OP2 == 0) { - INSTR("bic"); SHFT(res); RD = RN & ~res; UPCC(RD); break; + INSTR("bic"); SHFT(res); RD = RN & ~res; SHFT_UPCC(RD); break; } switch (BXTYPE) { case 0x9: UNIMP("ldrexb"); break; @@ -756,7 +846,7 @@ break; } break; case 0x0f: if (OP1 == 0 || OP2 == 0) { - INSTR("mvn"); SHFT(res); RD = ~res; UPCC(RD); break; + INSTR("mvn"); SHFT(res); RD = ~res; SHFT_UPCC(RD); break; } else { switch (BXTYPE) { case 0x9: UNIMP("ldrexh"); break;
Modified: cpu/arm/assem.fth ============================================================================== --- cpu/arm/assem.fth Tue Apr 5 17:13:03 2011 (r2182) +++ cpu/arm/assem.fth Tue Apr 5 21:48:04 2011 (r2183) @@ -1076,6 +1076,7 @@ : mvn 01e0.0000 {cond/s} amode-rdop2 ;
: movw 0300.0000 {cond} amode-movw ; +: movt 0340.0000 {cond} amode-movw ;
: mul 0000.0090 {cond/s} amode-mul ; : mla 0020.0090 {cond/s} amode-mla ; @@ -1140,6 +1141,20 @@ asm, \ const 051f.000c \ ldr rN,[pc,#-12] ; +: movwt ( reg# imm -- ) + \ newword contains conditional info we need to keep. + newword -rot ( newword reg# imm ) + lwsplit swap ( newword reg# imm.hi imm.lo ) + set-imm16 0300.0000 iop ( newword reg# imm.hi ) + over rd-field !op \ movw rN,#<imm> + ?dup if ( newword reg# imm.hi ) + rot is newword ( reg# imm.hi ) + set-imm16 0340.0000 iop ( reg# ) + rd-field !op \ movt rN,#<imm> + else + 2drop + then +; : (set) ( address? -- ) >r 0000.0000 {cond} init-operands @@ -1165,11 +1180,7 @@ then else ( reg# imm imm ) use-movw? if ( reg# imm imm ) - 1.0000 u< if ( reg# imm ) - set-imm16 0300.0000 ( reg# op ) \ movw rN,#<imm16> - else ( reg# imm ) - false asm-const ( reg# op ) - then ( reg# op ) + drop movwt exit else ( reg# imm imm ) drop false asm-const ( reg# op ) then ( reg# op )
Modified: cpu/arm/build/Makefile ============================================================================== --- cpu/arm/build/Makefile Tue Apr 5 17:13:03 2011 (r2182) +++ cpu/arm/build/Makefile Tue Apr 5 21:48:04 2011 (r2183) @@ -33,4 +33,4 @@ # Don't use *.dic so as not to remove builder.dic clean: rm -f tools.dic kernel.dic basefw.dic *.log headers *~ inflate.bin build *.tag - + make -C ../${OS} clean
Modified: cpu/arm/disassem.fth ============================================================================== --- cpu/arm/disassem.fth Tue Apr 5 17:13:03 2011 (r2182) +++ cpu/arm/disassem.fth Tue Apr 5 21:48:04 2011 (r2183) @@ -276,8 +276,9 @@ d#24 bit? 0= 5 2 bits 0= and if .alu-ext else .ld/st-ext then ;
-: .movw ( -- ) \ movw rN,#imm - ." movw" {<cond>} op.rd, ." #" +: .movtw ( -- ) \ movw rN,#imm + d#22 bit? if ." movt" else ." movw" then + {<cond>} op.rd, ." #" d# 16 4bits d# 12 << 0 d# 12 bits or u.h ;
@@ -285,7 +286,7 @@ : ?pc-change ( -- ) d# 12 4bits d# 15 = end-found ! ;
: .alu-op ( -- ) \ d# 25 3 bits 0|1 = - d#20 8bits h# 30 = if .movw exit then + d#20 8bits h# fb and h# 30 = if .movtw exit then d#25 bit? 0= d# 4 bit? and d# 7 bit? and if .ext exit then alu# h# d and h# d = if \ Moves .alu {s} op.rd, .r/imm
Modified: cpu/arm/kerncode.fth ============================================================================== --- cpu/arm/kerncode.fth Tue Apr 5 17:13:03 2011 (r2182) +++ cpu/arm/kerncode.fth Tue Apr 5 21:48:04 2011 (r2183) @@ -187,6 +187,20 @@ mov pc,r0 end-code
+\ execute-ip This word will call a block of Forth words given the address +\ of the first word. It's used, for example, in try blocks where the +\ a word calls 'try' and then the words that follow it are called repeatedly. +\ This word, execute-ip, is used to transfer control back to the caller of +\ try and execute the words that follow the call to try. + +\ see forth/lib/try.fth for more details. + +code execute-ip ( word-list-ip -- ) + psh ip,rp + mov ip,tos + pop tos,sp +c; + \ Run-time actions for compiling words
code branch ( -- ) @@ -331,7 +345,19 @@
code (endcase) ( n -- ) pop tos,sp c;
-code digit ( char base -- digit true�| char false ) +\ ($endof) is the same as branch, and ($endcase) is a noop, +\ but redefining them this way makes the decompiler much easier. +\ code ($case) ( $ -- $ ) c; + +code ($endof) ( -- ) +\rel ldr r0,[ip] +\rel add ip,ip,r0 +\abs ldr ip,[ip] +c; + +code ($endcase) ( -- ) c; + +code digit ( char base -- digit true | char false ) mov r0,tos \ r0 base ldr r1,[sp] \ r1 char and r1,r1,#0xff
Modified: cpu/x86/kerncode.fth ============================================================================== --- cpu/x86/kerncode.fth Tue Apr 5 17:13:03 2011 (r2182) +++ cpu/x86/kerncode.fth Tue Apr 5 21:48:04 2011 (r2183) @@ -222,6 +222,20 @@ \ Execute a Forth word given a code field address code execute (s acf -- ) w pop 0 [w] jmp end-code
+\ execute-ip This word will call a block of Forth words given the address +\ of the first word. It's used, for example, in try blocks where the +\ a word calls 'try' and then the words that follow it are called repeatedly. +\ This word, execute-ip, is used to transfer control back to the caller of +\ try and execute the words that follow the call to try. + +\ see forth/lib/try.fth for more details. + +code execute-ip (s word-list-ip -- ) + rp adec + ip 0 [rp] mov + ip pop +c; + \ High level branch. The branch offset is compiled in-line. code branch (s -- ) mloclabel bran1 @@ -318,6 +332,13 @@ code (endof) (s -- ) bran1 #) jmp end-code code (endcase) (s n -- ) ax pop c;
+\ ($endof) is the same as branch, and ($endcase) is a noop, +\ but redefining them this way makes the decompiler much easier. +\ code ($case) ( $ -- $ ) c; + +code ($endof) (s -- ) bran1 #) jmp end-code +code ($endcase) (s n -- ) c; + mloclabel yes assembler true # ax mov 1push c; mloclabel no assembler false # ax mov 1push c;
Modified: forth/lib/build.sh ============================================================================== --- forth/lib/build.sh Tue Apr 5 17:13:03 2011 (r2182) +++ forth/lib/build.sh Tue Apr 5 21:48:04 2011 (r2183) @@ -22,7 +22,7 @@ { until [ -d ofw ]; do if [ `pwd` = / ] ; then - echo Can't find firmware root directory + echo "Can't find firmware root directory" exit fi cd ..
Modified: forth/lib/decomp.fth ============================================================================== --- forth/lib/decomp.fth Tue Apr 5 17:13:03 2011 (r2182) +++ forth/lib/decomp.fth Tue Apr 5 21:48:04 2011 (r2183) @@ -181,6 +181,8 @@ : +branch ( ip-of-branch -- next-ip ) ta1+ /branch + ; : .endof ( ip -- ip' ) .." endof" indent +branch ; : .endcase ( ip -- ip' ) indent .." endcase" indent ta1+ ; +: .$endof ( ip -- ip' ) .." $endof" indent +branch ; +: .$endcase ( ip -- ip' ) indent .." $endcase" indent ta1+ ;
: add-break ( break-address break-type -- ) end-breaks @ breaks 40 /n* + >= ( adr,type full? ) @@ -213,6 +215,13 @@ ['] .endcase ?add-break +branch ; +: scan-$of ( ip-of-($of -- ip' ) + dup >target dup +extent ( ip next-$of ) + /branch - /token - ( ip $endof-addr ) + dup ['] .$endof add-break ( ip $endof-addr ) + ['] .$endcase ?add-break + +branch +; : scan-branch ( ip-of-?branch -- ip' ) dup dup forward-branch? if >target dup +extent ( branch-target-address) @@ -264,6 +273,7 @@ : .loop ( ip -- ip' ) -indent .." loop " +branch ; : .+loop ( ip -- ip' ) -indent .." +loop " +branch ; : .of ( ip -- ip' ) .." of " +branch ; +: .$of ( ip -- ip' ) .." $of " +branch ;
\ first check for word being immediate so that it may be preceded \ by [compile] if necessary @@ -340,8 +350,8 @@ ( 24 ) [compile] (n") ( 25 ) [compile] isdefer ( 26 ) [compile] isuser ( 27 ) [compile] isvalue ( 28 ) [compile] isconstant ( 29 ) [compile] isvariable - ( 30 ) [compile] dummy ( 31 ) [compile] dummy - ( 32 ) [compile] dummy ( 33 ) [compile] dummy + ( 30 ) [compile] ($of) ( 31 ) [compile] ($endof) + ( 32 ) [compile] ($endcase) ( 33 ) [compile] dummy ( 34 ) [compile] dummy ( 35 ) [compile] dummy
\ Print a word which has been classified by execution-class @@ -361,8 +371,8 @@ ( 24 ) .nstring ( 25 ) .is ( 26 ) .is ( 27 ) .is ( 28 ) .is ( 29 ) .is - ( 30 ) dummy ( 31 ) dummy - ( 32 ) dummy ( 32 ) dummy + ( 30 ) .$of ( 31 ) .$endof + ( 32 ) .$endcase ( 33 ) dummy ( 34 ) dummy ( 35 ) dummy ( default ) .word ; @@ -385,8 +395,8 @@ ( 24 ) skip-nstring ( 25 ) skip-word ( 26 ) skip-word ( 27 ) skip-word ( 28 ) skip-word ( 29 ) skip-word - ( 30 ) dummy ( 31 ) dummy - ( 32 ) dummy ( 32 ) dummy + ( 30 ) scan-$of ( 31 ) skip-branch + ( 32 ) skip-word ( 33 ) dummy ( 34 ) dummy ( 35 ) dummy ( default ) skip-word ;
Modified: forth/lib/loadcomm.fth ============================================================================== --- forth/lib/loadcomm.fth Tue Apr 5 17:13:03 2011 (r2182) +++ forth/lib/loadcomm.fth Tue Apr 5 21:48:04 2011 (r2183) @@ -43,6 +43,7 @@ fload ${BP}/forth/lib/format.fth
fload ${BP}/forth/lib/stringar.fth +fload ${BP}/forth/lib/strcase.fth
fload ${BP}/forth/lib/parses1.fth \ String parsing
Added: forth/lib/strcase.fth ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ forth/lib/strcase.fth Tue Apr 5 21:48:04 2011 (r2183) @@ -0,0 +1,50 @@ +\ This section introduces a new set of words: +\ $case $of $endof $endcase +\ The semantics are very similar to the standard +\ Forth case statement. + +\ Example of use: +\ : foo ( $ -- ) +\ ( $ ) $case +\ " abc" $of ." The string starts with abc" $endof +\ " xyz" $of ." Oh, it's an xyz string" $endof +\ ( $ ) ." **** It was " 2dup type +\ $endcase + +\ The default clause is optional. +\ When an $of clause is executed, the remaining selector string (past +\ the matched string) remains on the string. It is the user's +\ responsibility to dispose of the string. +\ When a default clause is executed, the entire selector string is +\ on the stack. The default clause must drop the selector, e.g., 2drop. + +\ At run time, ($of) tests the top of the stack against the selector. + +\ If the first N characters of the string supplied to $case are +\ the same, the selector string is shortened and the following +\ forth code is executed. If the first characters are not the +\ same, execution continues at the point just following the +\ the matching $endof + +\needs substring? fload ${BP}/forth/lib/substrin.fth + +: ($of) ( arg$ sel$ -- arg$' ) + 4dup 2swap substring? if + nip /string + r> cell+ >r \ Return to next word in $of clause + else + 2drop + r> dup @ + >r \ Skip to matching $endof + then +; + +: $case ( -- 0 ) +level 0 ; immediate +: $of ( -- >m ) ['] ($of) +>mark ; immediate +: $endof ( >m -- ) ['] ($endof) +>mark but ->resolve ; immediate + +: $endcase ( 0 [ >m ... ] -- ) + compile ($endcase) + begin ?dup while ->resolve repeat + -level +; immediate +