[openfirmware] r1039 - in cpu: . arm arm/Linux arm/build
svn at openfirmware.info
svn at openfirmware.info
Sat Dec 20 08:55:36 CET 2008
Author: wmb
Date: 2008-12-20 08:55:35 +0100 (Sat, 20 Dec 2008)
New Revision: 1039
Added:
cpu/arm/
cpu/arm/Linux/
cpu/arm/Linux/Makefile
cpu/arm/asmtools.fth
cpu/arm/assem.fth
cpu/arm/basefw.bth
cpu/arm/bitops.fth
cpu/arm/boot.fth
cpu/arm/build/
cpu/arm/build/Makefile
cpu/arm/builder.bth
cpu/arm/call.fth
cpu/arm/centry.fth
cpu/arm/code.fth
cpu/arm/cpubpsup.fth
cpu/arm/cpustate.fth
cpu/arm/ctrace.fth
cpu/arm/debugm.fth
cpu/arm/decompm.fth
cpu/arm/disassem.fth
cpu/arm/dodoesad.fth
cpu/arm/extra.fth
cpu/arm/fb8-ops.fth
cpu/arm/field.fth
cpu/arm/filecode.fth
cpu/arm/finish.fth
cpu/arm/float.fth
cpu/arm/forthint.fth
cpu/arm/ftrace.fth
cpu/arm/getms.fth
cpu/arm/inflate
cpu/arm/inflater.fth
cpu/arm/initpgm.fth
cpu/arm/kerncode.fth
cpu/arm/kernel.bth
cpu/arm/kernfloat.fth
cpu/arm/kernrel.fth
cpu/arm/loadmach.fth
cpu/arm/loadvmem.fth
cpu/arm/memtest.fth
cpu/arm/metainit.fth
cpu/arm/metarel.fth
cpu/arm/minifth.fth
cpu/arm/mmu.fth
cpu/arm/muldiv.fth
cpu/arm/native.bth
cpu/arm/objcode.fth
cpu/arm/objsup.fth
cpu/arm/psr.fth
cpu/arm/regacc.fth
cpu/arm/register.fth
cpu/arm/savefort.fth
cpu/arm/savemeta.fth
cpu/arm/scc.fth
cpu/arm/sqroot.fth
cpu/arm/sync.fth
cpu/arm/sys.fth
cpu/arm/target.fth
cpu/arm/testasm.txt
cpu/arm/testmmu.fth
cpu/arm/tools.bth
cpu/arm/traps.fth
cpu/arm/version.fth
Log:
ARM - initial checking of core OFW code for ARM
Added: cpu/arm/Linux/Makefile
===================================================================
--- cpu/arm/Linux/Makefile (rev 0)
+++ cpu/arm/Linux/Makefile 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,36 @@
+# Wrapper makefile for ARM Linux
+# Copyright 2008 FirmWorks. All rights reserved.
+#
+BP=../../..
+
+CFLAGS = -DARM -mlittle-endian
+
+WRTAIL = forth/wrapper
+WRDIR = ${BP}/${WRTAIL}
+ZIPTAIL = ${WRTAIL}/zip
+ZIPDIR = ${BP}/${ZIPTAIL}
+
+ZIPOBJS = zipmem.o deflate.o trees.o bits.o util.o inflate.o
+
+OBJS = wrapper.o logger.o ${ZIPOBJS}
+
+all: forth
+
+# Use forth when you just need to run Forth but don't care what
+# native instruction set it is on.
+# Use x86forth when you need to compile new dictionaries that will
+# run on x86 systems.
+forth: armforth
+ @ln -sf armforth forth
+
+armforth: ${OBJS}
+ ${CC} ${CFLAGS} ${LFLAGS} -o $@ ${OBJS}
+
+%.o: ${WRDIR}/%.c
+ ${CC} -c ${CFLAGS} $< -o $@
+
+%.o: ${ZIPDIR}/%.c
+ ${CC} -c ${CFLAGS} -I${ZIPDIR} $< -o $@
+
+clean:
+ @rm -f ${OBJS} forth armforth
Property changes on: cpu/arm/Linux/Makefile
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/asmtools.fth
===================================================================
--- cpu/arm/asmtools.fth (rev 0)
+++ cpu/arm/asmtools.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,114 @@
+purpose: Tools for creating disembodied assembly code sequences
+\ See license at end of file
+
+[ifndef] set-transize
+fload ${BP}/forth/lib/transien.fth
+true is suppress-transient? \ Disable transient definitions for now
+[then]
+
+\needs suppress-headerless? fload ${BP}/forth/lib/headless.fth
+
+[ifndef] arm-assembler
+fload ${BP}/cpu/arm/assem.fth
+fload ${BP}/cpu/arm/code.fth
+fload ${BP}/forth/lib/loclabel.fth
+[then]
+
+also forth definitions
+: c$, ( adr len -- )
+ 1+ here swap note-string dup allot move 4 (align)
+;
+previous definitions
+
+[ifdef] notyet
+also arm-assembler definitions
+\needs $-to-r3 fload ${BP}/cpu/powerpc/asmmacro.fth
+
+: $find-dropin, ( adr len -- )
+ $-to-r3 \ Assemble string and skip it
+ " find-dropin bl *" evaluate \ and call find routine
+;
+previous definitions
+[then]
+
+false value transient-labels?
+0 value asm-origin
+0 value asm-base
+: pad-to ( n -- )
+ begin dup here asm-base - asm-origin + u> while 0 c, repeat drop
+;
+: align-to ( boundary -- )
+ here asm-base - swap round-up pad-to
+;
+
+[ifndef] enable-transient?
+: enable-transient ( -- )
+ suppress-transient? if
+ unused 4 / d# 1000 set-transize
+ false is suppress-transient?
+ false is suppress-headerless?
+ then
+;
+[then]
+enable-transient
+
+: tconstant ( value "name" -- )
+ transient? 0= dup >r if transient then
+ constant
+ r> if resident then
+;
+: label ( "name" -- )
+ transient-labels? if
+ here tconstant
+ [ also assembler ] init-labels [ previous ] !csp entercode
+ else
+ label
+ then
+;
+
+: set-asm-origin ( -- )
+ here to asm-base
+ 0 to asm-origin
+;
+
+0 0 2value old-asms
+: start-assembling ( -- )
+ \ Use "is" instead of "to" in the next line because "to" is a PowerPC
+ \ assembly mnemonic (trap on overflow).
+ [ also assembler also helpers ]
+ ['] asm@ behavior ['] asm! behavior to old-asms
+ ['] le-l@ is asm@ ['] le-l! is asm!
+ [ previous previous ]
+ set-asm-origin
+ true to transient-labels?
+;
+: end-assembling ( -- )
+ [ also assembler also helpers ]
+ old-asms is asm! is asm@
+ [ previous previous ]
+ false to transient-labels?
+;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1995 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/asmtools.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/assem.fth
===================================================================
--- cpu/arm/assem.fth (rev 0)
+++ cpu/arm/assem.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,1085 @@
+purpose: Prefix assembler for ARM Instruction Set
+\ See license at end of file
+
+\ create testing
+
+[ifndef] skipwhite
+: skipwhite ( adr1 len1 -- adr2 len2 )
+ begin dup 0> while ( adr len )
+ over c@ bl > if exit then
+ 1 /string
+ repeat ( adr' 0 )
+;
+[then]
+\needs land : land and ;
+
+\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
+
+\ Define symbolic names for constants in this vocabulary
+\ vocabulary register-names
+\ vocabulary constant-names
+vocabulary helpers
+
+also helpers definitions
+
+headerless
+hex
+
+[ifdef] testing
+0 value aoffset
+[then]
+
+0 value newword
+
+defer here \ ( -- adr ) actual dictionary pointer, metacomp. calculates host/target adresses
+defer asm-allot \ ( n -- ) allocate memory in the code address space
+
+\ defer byte! \ ( c adr -- ) write char to adr, metacompiler changes this
+defer asm! \ ( n adr -- ) write n to adr "
+defer asm@ \ ( adr -- n ) read n at adr "
+
+defer asm-set-relocation-bit
+
+also arm-assembler definitions
+: asm, ( n -- ) here /l asm-allot asm! ;
+previous definitions
+
+: !op ( -- ) newword asm, ;
+
+0 value op-end
+
+0 value last-len
+
+0 value rem-adr
+0 value rem-len
+: set-rem$ ( adr len -- ) is rem-len is rem-adr ;
+: rem$ ( -- adr len ) rem-adr rem-len ;
+
+d# 128 buffer: cbuf
+0 value clen
+
+: field-bounds ( -- end start )
+ op-end dup rem-len - swap last-len -
+;
+
+0 value adr-delim
+
+: xop ( change-bits -- ) newword xor is newword ;
+: iop ( on-bits -- ) newword or is newword ;
+
+: ad-error ( msg$ -- )
+ \ Types the message passed in, the contents of cbuf and the stack.
+ type cr
+ where #out @ >r
+ source type cr
+ field-bounds dup r> + spaces ( end start ) ?do ." ^" loop cr
+ abort
+;
+
+\ : $asm-find ( word$ -- word$ false | xt true ) ['] register-names $vfind ;
+: $asm-find ( word$ -- word$ false | xt true ) ['] arm-assembler $vfind ;
+
+: $asm-execute ( name$ -- ?? )
+ $asm-find 0= if " Unknown symbol" ad-error then execute
+;
+
+: set-parse ( adr len -- )
+ cbuf over set-rem$ cbuf swap move rem-len is clen
+ cbuf clen lower
+;
+
+: mark-position ( -- )
+ >in @ source drop >in @ + 1- c@ bl <= if 1- then is op-end
+;
+: save-parse ( -- )
+ \ Save the current >in pointer, parse the next word and copy it
+ \ into cbuf for processing, then erase the rest of cbuf.
+ parse-word set-parse
+ mark-position
+;
+
+: /rem ( n -- ) rem$ rot /string set-rem$ ;
+
+: init-operands ( -- )
+\ We can't do this because rem$ isn't set if we have an exact match
+\ rem-len abort" Invalid opcode"
+ 0 0 set-rem$
+;
+
+\ Backup one character if the last get-field found a non-zero delimiter.
+: backover-delim ( -- ) adr-delim 0<> /rem ;
+
+: set-field ( n bit# -- ) lshift iop ;
+: rotr ( x cnt -- x' )
+ \ Rotate x right cnt bits within a 32 bit "register."
+ d# 32 mod 2dup rshift -rot d# 32 swap - lshift or
+;
+
+: rotl ( x cnt -- x' )
+ \ Rotate x ldef cnt bits within a 32 bit "register."
+ d# 32 mod 2dup lshift -rot d# 32 swap - rshift or
+;
+
+: 2chars ( -- n )
+ \ This packs the first two characters of the string onto TOS.
+ rem-adr dup 1+ c@ swap c@ bwjoin
+;
+
+: parse-1 ( ch -- flag )
+ rem-len 1 >= if
+ rem-adr c@ = if 1 /rem true exit then
+ else
+ drop
+ then
+ false
+;
+
+\ ----------------
+\ : lex ( text$ delim$ -- rem$ head$ delim true | text$ false )
+
+: next-cons dup 1+ swap ;
+78f1e000
+next-cons constant adt-empty \ End of line.
+next-cons constant adt-delimiter \ Delimiter is 1st character.
+next-cons constant adt-1st \ First of the address word types.
+next-cons constant adt-psrfld \ _c, _f, etc.
+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-shift \ Shift op in Shifter Operands.
+next-cons constant adt-rrx
+next-cons constant adt-immed \ #immediate_value.
+ constant adt-last \ Last +1 of the address word types.
+
+: adt? ( n -- adt? ) adt-1st adt-last within ;
+
+\ -----------------------------
+( Here's some code from the PowerPC assembler that will handle
+ *
+ | <based-number>
+where <based-number> is
+ <decimal-digits>
+ | d#<decimal-digits>
+ | h#<hex-digits>
+ | 0x<hex-digits>
+ | o#<octal-digits>
+ | b#<binary-digits>
+ | <any-word-in-the-'constant-names'-vocabulary>
+ )
+
+\ If adr2,len2 is an initial substring of adr1,len1, return the remainder
+\ of the adr1,len1 string following that initial substring.
+\ Otherwise, return adr1,len1
+: ?remove ( adr1 len1 adr2 len2 -- adr1 len1 false | adr1+len2 len1-len2 true )
+ 2 pick over u< if 2drop false exit then \ len2 too long?
+ 3 pick rot 2 pick ( adr len1 len2 adr1 adr2 len2 )
+ caps-comp 0= if /string true else drop false then
+;
+: set-base ( adr len -- adr' len' )
+ " h#" ?remove if hex exit then
+ " 0x" ?remove if hex exit then
+ " d#" ?remove if decimal exit then
+ " o#" ?remove if octal exit then
+ " 0o" ?remove if octal exit then
+ " b#" ?remove if binary exit then
+ " 0b" ?remove if binary exit then
+;
+
+headers
+
+headerless
+: get-based-number ( adr len -- true | n false )
+ \ The following case statement handles preceding signs because
+ \ the <mumble> who laid out the assembler addressing put the sign
+ \ after the # sign on ldr and str instructions.
+ over c@ case
+ ascii - of true >r 1 /string endof
+ ascii + of false >r 1 /string endof
+ ( default ) false >r
+ endcase
+
+\ ['] register-names $vfind if execute r> if negate then false exit then
+ ['] arm-assembler $vfind if execute r> if negate then false exit then
+ base @ >r decimal
+ set-base
+ $number
+ r> base !
+ r> over 0= land if swap negate swap then
+;
+: number ( [ n1 ] adr len -- n2 )
+ 2dup " *" $= if 2drop then
+ get-based-number abort" Bad number"
+;
+
+headers hex
+\ -----------------------------
+
+: ?next-word ( -- empty? )
+ \ If the current string is empty, parse another word.
+ rem-len 0= if ( )
+ parse-word set-parse mark-position ( )
+ then ( )
+ false ( false )
+;
+
+: start-field ( -- )
+ rem$ skipwhite set-rem$
+ rem-len is last-len
+;
+
+\ False means that there was nothing at all; no delimiter, and no field
+: get-field ( -- false | fld$ true )
+ ?next-word if false exit then
+ rem-len is last-len
+
+ \ Get a field out of the string.
+ rem$ " !#*+,-[]^_{}`" lex 0= if ( field$ )
+ 0 0 2swap 0 ( rem$ field$ delim )
+ then ( rem$ field$ delim )
+ is adr-delim 2swap set-rem$ ( field$ )
+ dup 0<> adr-delim or if ( field$ )
+ true ( field$ true )
+ else ( null$ )
+ 2drop false ( false )
+ then ( false | field$ true )
+;
+
+: ?missing-operand ( empty? -- ) 0= if " Missing operand" ad-error then ;
+: require-field ( -- field$ ) get-field ?missing-operand ;
+
+: cond: ( n1 "name" -- ) d# 28 lshift constant ;
+
+: psr: ( n1 "name" -- ) create 10 lshift , does> @ adt-psrfld ;
+: psrs: ( 10x"name" -- ) 10 1 do i psr: loop ;
+
+\ define the registers
+: reg: ( n "name" -- ) create , does> @ adt-reg ;
+: regs: ( 10x"name" -- ) 10 0 do i reg: loop ;
+
+\ Define the co-processors.
+: coproc: ( n "name" -- ) create , does> @ adt-coproc ;
+: coprocs: ( 10x"name" -- ) 10 0 do i coproc: loop ;
+
+\ Define the co-processor registers.
+: coreg: ( n "name" -- ) create , does> @ adt-coreg ;
+: coregs: ( 10x"name" -- ) 10 0 do i coreg: loop ;
+
+: range-error ( n msg$ -- ) type .d cr abort ;
+
+: expecting ( $ -- ) ." Expecting " ad-error ;
+: ?expecting ( flag msg$ -- ) rot if expecting else 2drop then ;
+: ?#bits ( n #bits -- n )
+ 2dup 1 swap lshift 1- invert and if ( n #bits )
+ ." Value won't fit in " .d " bits" ad-error
+ then ( n #bits )
+ drop
+;
+
+: fits? ( n -- okay? )
+ 10 0 do
+ dup ffffff00 land 0= if
+ \ This rotation fits, package it.
+ i 8 set-field iop true unloop exit
+ else
+ 2 rotl
+ then
+ loop
+ drop false
+;
+: do-#32 ( x -- )
+ fits? 0= if " Immediate value won't fit in 8 bits" ad-error then
+;
+
+: get-number ( -- n )
+ ?next-word 0= ?missing-operand
+
+ \ Get a field out of the string.
+ rem$ " !*,[]^_{}" lex 0= if ( field$ )
+ 0 0 2swap 0 ( rem$ field$ delim )
+ then ( rem$ field$ delim )
+ is adr-delim 2swap set-rem$ ( field$ )
+
+ get-based-number " number" ?expecting ( n )
+;
+
+: parse-error ( -- ) " Unrecognized address field" ad-error ;
+: fix-parse-buffer ( -- )
+ \ Now we have to fix up the parse buffer
+ source >in @ > if ( adr )
+ \ The input buffer is not empty
+ >in @ + c@ case ( char )
+ [char] ] of [char] ] is adr-delim 1 >in +! endof
+ [char] , of [char] , is adr-delim 1 >in +! endof
+ endcase ( )
+ else ( adr )
+ drop
+ then
+ " " set-parse mark-position
+;
+: execute-inline ( -- ?? )
+ rem-len if ( )
+ rem$ " `" lex if ( rem$ field$ delim )
+ \ Delimiter was found; handle field and exit
+ drop 2swap set-rem$ ( field$ )
+ evaluate
+ [char] ] parse-1 if [char] ] is adr-delim else
+ [char] , parse-1 if [char] , is adr-delim then then
+ exit ( ?? )
+ then ( field$ )
+ 0 0 set-rem$ ( field$ )
+ cbuf place ( )
+ " " cbuf $cat ( )
+ else ( )
+ 0 cbuf c! ( )
+ then ( )
+ [char] ` parse cbuf $cat ( )
+ cbuf count evaluate ( ??' )
+
+ fix-parse-buffer
+;
+: get-whatever ( -- [ value ] adt-code )
+ get-field 0= if adt-empty exit then ( field$ )
+ dup if ( field$ )
+ 2dup $asm-find if ( field$ xt )
+ execute 2nip ( n adt-code)
+ dup adt? 0= if parse-error then
+ else ( field$ field$ )
+ get-based-number if parse-error then ( field$ n )
+ adt-immed 2nip ( n adt-code )
+ then ( n adt-code )
+ else ( null$ )
+ \ Empty string, is this delimiter only?
+ 2drop adr-delim case ( delim )
+ ascii # of ( )
+ \ Immediate value.
+ \ Now we have a slight problem with the current get-field; the
+ \ delimiter # is acceptable within the number string, e.g.,
+ \ h#0ff0, and other delimiters are allowed after the number,
+ \ e.g., #h#0ff0]! is legitimate in load and store instructions.
+ \ Until I figure a nicer hack for get-field, we'll handle the
+ \ problem by hand here, using get-number above.
+ get-number adt-immed ( value adt-code )
+ endof ( value adt-code )
+ ascii * of ( value adt-code )
+ \ Value from Stack
+ dup adt? 0= if adt-immed then
+ endof ( value adt-code )
+ ascii ` of
+ \ In-line Forth commands, terminated by another `
+ execute-inline ( ?? )
+ dup adt? 0= if adt-immed then
+ endof
+ ( delim )
+ \ A no action (here, at least) delimiter, pass it back.
+ adt-delimiter over
+ endcase ( value adt-code )
+ then ( value adt-code )
+;
+
+: get-this ( adt-x msk pos -- )
+ >r >r >r get-whatever ( value adt-code R: pos msk adt-x )
+ dup r> <> swap adt-immed <> and " immediate" ?expecting
+ ( val R: pos msk )
+ r> invert over land if " Value exceeds field size" ad-error then
+ r> set-field
+;
+
+: ?register ( adt -- ) adt-reg <> " register" ?expecting ;
+
+: get-immediate ( -- n )
+ get-whatever adt-immed <> " immediate" ?expecting
+;
+
+: get-register ( -- reg )
+ require-field
+ dup if ( field$ )
+ $asm-execute ?register ( reg )
+ else ( null$ )
+ 2drop ( )
+ adr-delim ascii * <> " register" ?expecting ( reg [ adt-reg ] )
+ ascii , parse-1 drop ( reg [ adt-reg ] )
+ dup adt-reg = if drop then ( reg )
+ dup fffffff0 land if " Invalid register number: " range-error then
+ then ( reg )
+;
+
+: get-rn ( bit# -- ) get-register swap set-field ;
+: get-r00 ( -- ) 0 get-rn ;
+: get-r08 ( -- ) 8 get-rn ;
+: get-r12 ( -- ) d# 12 get-rn ;
+: get-r16 ( -- ) d# 16 get-rn ;
+
+: expecting-reg/immed ( -- ) " register or immediate" expecting ;
+: get-shiftr# ( -- )
+ \ Back over a real delimiter, then get the next thing.
+ backover-delim get-whatever case
+ adt-reg of 8 set-field 0000.0010 iop endof
+ adt-immed of 6 ?#bits 7 set-field endof
+ expecting-reg/immed
+ endcase
+;
+
+: get-shift# ( -- )
+ backover-delim get-immediate 6 ?#bits 7 set-field
+;
+
+: expecting-shift ( -- ) " shift specifier" expecting ;
+: get-shiftop ( -- )
+ require-field ( field$ )
+ \ We have something, check it out.
+ $asm-execute case
+ adt-shift of iop get-shiftr# endof
+ adt-rrx of iop endof
+ expecting-shift
+ endcase
+;
+
+: get-shiftop2 ( -- )
+ get-whatever case
+ adt-empty of endof
+ adt-shift of iop get-shiftr# endof
+ adt-rrx of iop endof
+ expecting-shift
+ endcase
+;
+
+: get-shiftls ( -- )
+ get-whatever case
+ adt-shift of iop get-shift# endof
+ adt-rrx of iop endof
+ expecting-shift
+ endcase
+;
+
+: set-i ( -- ) 0200.0000 iop ;
+: p? ( -- flag ) newword 0100.000 land 0<> ;
+: flip-u ( -- ) 0080.0000 xop ;
+: flip-b ( -- ) 0040.0000 xop ;
+: flip-w ( -- ) 0020.0000 xop ;
+
+: get-opr2 ( -- ? )
+ adr-delim ascii , = if 0 is adr-delim then
+ backover-delim get-whatever case
+ adt-reg of iop adr-delim ascii , = if get-shiftop2 then endof
+ adt-immed of set-i do-#32 endof
+ expecting-reg/immed
+ endcase
+;
+
+
+: >offset ( to from -- offset ) 8 + - ;
+
+: >br-offset ( to from -- masked-offset )
+ >offset 2 >>a
+ dup -0080.0000 007f.ffff between
+ 0= abort" Branch displacement out of 24-bit range"
+ 00ffffff land
+;
+: amode-bbl ( b-adr -- )
+ init-operands
+[ifdef] testing
+ get-whatever drop aoffset
+[else]
+ get-immediate here
+[then]
+ >br-offset iop
+ !op
+;
+
+: amode-bx ( -- ) init-operands get-r00 !op ;
+
+: ?psr ( adt -- ) adt-xpsr <> " [cs]psr" ?expecting ;
+
+: amode-mrs ( -- ) init-operands get-r12 get-whatever ?psr iop !op ;
+
+: amode-msr ( -- )
+ init-operands
+
+ \ get xpsr and fields
+ require-field $asm-execute ?psr iop ( )
+
+ \ Get any _X PSR subfields
+ begin adr-delim ascii _ = while
+ \ Get the field following the _ and back over the _.
+ require-field -1 /rem ( field$ )
+ $asm-execute adt-psrfld <> " PSR-field" ?expecting ( psr-field )
+ iop ( )
+ repeat ( )
+
+ \ get r-or-imed, if imed, field = 8 or error.
+ \ Get the next field which we expect to be rx, or #num.
+ require-field adr-delim case ( field$ delim )
+ ascii * of \ Take the address from the stack ( n adt-code field$ )
+ 2drop do-#32 newword fff0ffff land 02080000 or is newword
+ endof
+
+ ascii # of ( field$ )
+ \ Immediate address, the field should be empty and the real
+ \ field is the next one.
+ \ get an immediate field, the default is _f = 8,
+ newword fff0ffff land 02080000 or is newword
+ endof
+
+ 0 of \ This should be a register. ( field$ )
+ $asm-execute ?register xop ( )
+
+ \ If no field bits are set, use the default _cf
+ 000f0000 newword and 0= if 0009.0000 xop then
+
+ \ There should be nothing left on the parse string.
+ rem-len if " Extra characters" ad-error then
+ endof
+
+ expecting-reg/immed
+ endcase
+ !op
+;
+
+: (amode-mul) ( -- ) init-operands get-r16 get-r00 get-r08 ;
+: amode-mul ( -- ) (amode-mul) !op ;
+: amode-mla ( -- ) (amode-mul) get-r12 !op ;
+: amode-lmul ( -- ) init-operands get-r12 get-r16 get-r00 get-r08 !op ;
+: amode-rrop2 ( -- ) init-operands get-r12 get-r16 get-opr2 !op ;
+: amode-rnop2 ( -- ) init-operands get-r16 get-opr2 !op ;
+: amode-rdop2 ( -- ) init-operands get-r12 get-opr2 !op ;
+
+: amode-lsm ( -- )
+ init-operands
+ 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
+
+ \ The next thing up should be an open brace for the register list.
+ get-whatever adt-delimiter <> " {" ?expecting
+ ascii { <> " {" ?expecting
+
+ begin adr-delim ascii } <> while
+ get-whatever case ( value adt )
+
+ adt-reg of ( reg )
+ \ Check the delimiter for - meaning a range.
+ adr-delim ascii - = if ( reg1 )
+ get-whatever ?register ( reg1 reg2 )
+ 1+ swap ?do 1 i set-field loop ( )
+ else ( reg )
+ \ Simple register, set its bit.
+ 1 swap set-field
+ then
+ endof
+
+ " register or }" expecting
+ endcase
+ repeat
+
+ \ We've finished the register list, is there a ^ hanging on the end?
+ ascii ^ parse-1 if flip-b then
+
+ !op
+;
+
+\ rd, [rn, <immed12>] {!}
+\ rd, [rn, +-rm] {!}
+\ rd, [rn, +-rm, <shift>] {!}
+\ rd, [rn], <immed12>
+\ rd, [rn], +-rm
+\ rd, [rn], +-rm, <shift>
+\ The first 3 can be followed by "!" unless the opcode has a "t" at the end
+\ The {!} is handled by amode-lsr
+
+: get-off12 ( -- )
+ get-whatever case
+ adt-delimiter of
+ case
+ ascii + of endof \ Redundant but there.
+ ascii - of flip-u endof \ Clear the add bit, I[23]=0.
+ ascii ] of endof \ Can this happen?
+ " Unexpected delimiter in address" ad-error
+ endcase
+ \ Process the rest of the address, which should be a register plus?.
+ set-i get-r00 adr-delim ascii ] <> if get-shiftls then
+ endof
+
+ adt-immed of
+ \ If the value is negative, switch things around.
+ dup 0< if negate flip-u then
+ d# 12 ?#bits iop
+ \ Check for terminating ] as needed ( if I[24]=1 ).
+ newword 0100.0000 land if
+ adr-delim ascii ] <> " ] " ?expecting
+ then
+ endof
+
+ adt-reg of
+ iop set-i adr-delim ascii , = if get-shiftls then
+ endof
+
+ expecting-reg/immed
+ endcase
+;
+
+defer do-offset
+: get-ea ( do-offset-xt -- )
+ is do-offset
+
+\ adr-delim ascii [ = if exit then
+
+ 0100.0000 iop \ Assume pre-indexing
+
+ require-field dup if ( adr len )
+ ['] arm-assembler $vfind if execute exit then ( adr len )
+ " address specifier" expecting
+ then ( adr 0 )
+ 2drop ( )
+
+ adr-delim ascii [ <> " [" ?expecting
+ 0 is adr-delim
+
+ get-r16
+ adr-delim ascii ] = if \ [rn]
+ \ Look for a comma after the close bracket.
+ ascii , parse-1 if \ [rn], <immed>
+ 0100.0000 xop do-offset
+ then
+ else \ [rn, ...
+ do-offset
+ then
+;
+
+: (amode-ls) ( -- )
+ \ The default case is to add to the base register, which is I[23]=1.
+ \ If we have a negative offset we clear the appropriate bits later.
+ 0080.0000 iop
+
+ get-r12 ['] get-off12 get-ea
+;
+: amode-lst ( -- ) init-operands (amode-ls) !op ;
+
+: {!} ( -- ) ascii ! parse-1 if flip-w then ;
+
+: amode-lsr ( -- ) init-operands (amode-ls) {!} !op ;
+
+: get-off8 ( -- )
+ \ Get the offset for [ldr|str][h\sh\sb] instructions.
+ get-whatever case
+ adt-delimiter of
+ case
+ ascii + of flip-b get-r00 endof
+ ascii - of flip-u flip-b 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
+ 8 ?#bits dup f0 land 4 set-field 0f land iop
+ endof
+
+ adt-reg of xop flip-b endof
+
+ expecting-reg/immed
+ endcase
+ p? if {!} then
+;
+
+\ rd, [rn, <immed8>] {!}
+\ rd, [rn, +-rm] {!}
+\ rd, [rn], <immed8>
+\ rd, [rn], +-rm
+
+: amode-lssh ( -- )
+ init-operands
+ \ Set the add offset and immediate value as defaults.
+ 00c0.0000 iop
+ get-r12 ['] get-off8 get-ea
+ !op
+;
+
+: amode-imed24 ( -- )
+ init-operands get-immediate d# 24 ?#bits iop !op
+;
+
+: get-off0 ( -- ) " Offset not allowed" ad-error ;
+: amode-swp ( -- )
+ init-operands get-r12 get-r00 ['] get-off0 get-ea !op
+;
+
+: amode-copr ( -- ) \ Co-processors: mcr, mrc
+ \ p, #, r, c, c, #
+ init-operands
+ adt-coproc 0f 08 get-this
+ adt-immed 07 15 get-this
+ adt-reg 0f 0c get-this
+ adt-coreg 0f 10 get-this
+ adt-coreg 0f 00 get-this
+ adt-immed 07 05 get-this
+ !op
+;
+
+: amode-cdp ( -- ) \ Co-processors: cdp
+ \ p, #, c, c, c, #
+ init-operands
+ adt-coproc 0f 08 get-this
+ adt-immed 0f 14 get-this
+ adt-coreg 0f 0c get-this
+ adt-coreg 0f 10 get-this
+ adt-coreg 0f 00 get-this
+ adt-immed 07 05 get-this
+ !op
+;
+
+\ Get the offset for ldc, stc instructions.
+: get-off-c ( -- )
+ get-immediate
+ \ If the value is negative, negate value, otherwise set add.
+ dup 0< if negate else flip-u then
+ dup 3 and if " Unaligned offset" ad-error then
+ 2 rshift 8 ?#bits iop
+ p? if {!} else flip-w then
+;
+
+: amode-lsc ( -- ) \ Co-processors: ldc, stc
+ init-operands
+ adt-coproc 0f 08 get-this
+ adt-coreg 0f 0c get-this
+ ['] get-off-c get-ea
+ !op
+;
+
+\ ----------------
+
+: next-2? ( -- $ true | false )
+ rem-len 2 < if
+ false ( false )
+ else ( )
+ rem-adr 2 true 2 /rem 0 is adr-delim
+ then
+;
+
+\ This word looks for [|b] on swp commands.
+: {b} ( -- ) ascii b parse-1 if flip-b then ;
+
+\ If the s flag is found, set bit 20 for alu commmands.
+: {s} ( -- ) ascii s parse-1 if 0010.0000 iop then ;
+
+: {hbt} ( -- )
+ ascii h parse-1 if 0400.00b0 xop amode-lssh exit then
+ ascii b parse-1 if flip-b then
+ ascii t parse-1 if flip-w amode-lst exit then
+ amode-lsr
+;
+: {shbt} ( -- )
+ ascii s parse-1 if
+ ascii b parse-1 if 0400.00d0 xop else
+ ascii h parse-1 if 0400.00f0 xop else " b or h" expecting then then
+ amode-lssh
+ else
+ {hbt}
+ then
+;
+
+: parse-condition? ( -- cond true | false )
+ \ The next two characters of the input string will be checked for a
+ \ valid condition code. If found, the appropriate code will be
+ \ left on the stack between the updated string pair and true (TOS).
+ \ If not, The original string pair and false will be left on the stack.
+ next-2? if
+ \ Correct conditions get an even result from sindex.
+ " eqnecsccmiplvsvchilsgeltgtleal00eqnehslo" sindex dup 1 and if
+ drop -2 /rem false
+ else ( index )
+ 2/ h# f land true
+ then
+ else
+ false
+ then
+;
+
+: {cond} ( opcode -- )
+ is newword
+ \ The next two characters of the input string will be checked for a
+ \ valid condition code. If found, the appropriate code will be
+ \ inserted in newword and the string pointer / length will be
+ \ updated. If not, the code for always will be inserted in newword
+ \ and the string pair will be unchanged.
+ parse-condition? 0= if h# e then
+ d# 28 set-field \ put the condition code in.
+;
+: {cond/s} ( opcode -- ) {cond} {s} ;
+
+: 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
+
+ \ Correct tags have an even index from sindex.
+ " daiadbibfafdeaed" sindex dup 1 land " increment specifier" ?expecting
+
+ \ If we have an alternative code and stm, invert the bits.
+ dup 8 land r> land if 6 xor then
+
+ 6 land d# 22 lshift xop
+;
+
+: ?match ( #chars -- false | xt true )
+ rem-len over < if drop false exit then ( #chars )
+ rem-adr over ['] arm-assembler search-wordlist if ( #chars xt )
+ swap /rem true ( xt true )
+ else ( #chars )
+ drop false ( false )
+ then
+;
+: $arm-assem-do-undefined ( adr len -- )
+ \ Get the next string on the input stream, copy it and make it lower case.
+ set-parse rem$ lower ( )
+
+ 5 ?match if execute exit then
+ 3 ?match if execute exit then
+
+ \ Don't try a 2-character match if the string length is 3, because,
+ \ for example, "blt" (i.e. b{lt}) would then match "bl" instead of "b".
+ rem-len 3 <> if 2 ?match if execute then then
+
+ 1 ?match if execute exit then
+
+ rem$ $interpret-do-undefined
+;
+: $assemble ( adr len -- )
+ dup 0= if 2drop exit then
+
+\ ['] directives $vfind if execute exit then ( adr len )
+
+ $arm-assem-do-undefined
+;
+
+: resident ( -- )
+\ little-endian
+\ aligning? on
+ [ also forth ] ['] here [ previous ] is here
+ [ also forth ] ['] allot [ previous ] is asm-allot
+ [ also forth ] ['] le-l@ [ previous ] is asm@
+ [ also forth ] ['] instruction! [ previous ] is asm!
+[ifdef] set-relocation-bit
+ ['] set-relocation-bit is asm-set-relocation-bit
+[else]
+ ['] noop is asm-set-relocation-bit
+[then]
+;
+resident
+
+headers
+also arm-assembler definitions
+\ also register-names definitions
+: lsl ( -- n1 n2 ) 00000000 adt-shift ;
+: lsr ( -- n1 n2 ) 00000020 adt-shift ;
+: asr ( -- n1 n2 ) 00000040 adt-shift ;
+: ror ( -- n1 n2 ) 00000060 adt-shift ;
+: rrx ( -- n1 n2 ) 00000060 adt-rrx ;
+
+: spsr ( -- n1 n2 ) 00400000 adt-xpsr ;
+: cpsr ( -- n1 n2 ) 00000000 adt-xpsr ;
+
+psrs: _c _x _cx _s _cs _xs _cxs _f _cf _xf _cxf _sf _csf _xsf _cxsf
+1 psr: _ctl
+8 psr: _flg
+9 psr: _all
+
+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
+
+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 ;
+
+: mov 01a0.0000 {cond/s} amode-rdop2 ;
+: mvn 01e0.0000 {cond/s} amode-rdop2 ;
+
+: 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 ;
+
+: swp 0100.0090 {cond} {b} amode-swp ;
+
+: ldm 0810.0000 {cond} 1 parse-inc amode-lsm ;
+: stm 0800.0000 {cond} 0 parse-inc amode-lsm ;
+
+: ldr ( -- ) 0410.0000 {cond} {shbt} ;
+: str ( -- ) 0400.0000 {cond} {hbt} ;
+
+: rd-field ( reg# -- ) d# 12 set-field ;
+: rb-field ( reg# -- ) d# 16 set-field ;
+
+\ XXX need ADR, SET
+\ adr{cond} rN,<address>
+: (set) ( address? -- )
+ >r
+ 0000.0000 {cond} init-operands
+ \ Put the register number on the return stack so it won't interfere
+ \ with the stack items used by any "*" operands there may be.
+ get-register >r ( r: adr? reg# )
+ get-immediate ( address r: adr? reg# )
+ dup here >offset ( address offset r: adr? reg# )
+ dup fits? if ( address offset r: adr? reg# )
+ nip nip 028f.0000 ( op r: adr? reg# ) \ add rN,pc,#<offset>
+ else ( address offset r: adr? reg# )
+ negate fits? if ( address r: adr? reg# )
+ drop 024f.0000 ( op r: adr? reg# ) \ sub rN,pc,#<offset>
+ else ( address r: adr? reg# )
+ ea00.0000 asm, ( address r: adr? reg# ) \ b here+8
+ r> r@ swap >r if ( address r: adr? reg# )
+ here asm-set-relocation-bit drop
+ then
+ asm, ( r: adr? reg# ) \ adr
+ 051f.000c ( op r: adr? reg# ) \ ldr rN,[pc,#-12]
+ then ( op r: adr? reg# )
+ then ( op r: adr? reg# )
+ iop r> rd-field ( )
+ r> drop
+ !op
+;
+: adr ( -- ) true (set) ;
+: set ( -- ) false (set) ;
+
+: nop ( -- ) h# e1a00000 asm, ; \ mov r0,r0
+
+: # ( -- adt-immed ) adt-immed ;
+: reg ( -- adt-reg ) adt-reg ;
+
+headerless
+00 cond: = 00 cond: 0=
+01 cond: <> 01 cond: 0<>
+02 cond: u>=
+03 cond: u<
+04 cond: 0<
+05 cond: 0>=
+06 cond: vs
+07 cond: vc
+08 cond: u>
+09 cond: u<=
+0a cond: >=
+0b cond: <
+0c cond: > 0c cond: 0>
+0d cond: <= 0d cond: 0<=
+0e cond: always
+
+: -cond ( cond -- !cond ) 1000.0000 xor ;
+
+: put-branch ( target where -- ) tuck >br-offset ea00.0000 or swap asm! ;
+: put-call ( target where -- ) tuck >br-offset eb00.0000 or swap asm! ;
+
+: brif ( target cond -- ) swap here >br-offset or 0a00.0000 or asm, ;
+
+\ These implementation factors are used by the local labels package
+: <mark ( -- <mark ) here ;
+: >mark ( -- >mark ) here ;
+: >resolve ( >mark -- ) here over >br-offset over asm@ + swap asm! ;
+: <resolve ( <mark -- <mark ) ;
+
+headers
+: but ( mark1 mark2 -- mark2 mark1 ) swap ;
+: yet ( mark -- mark mark ) dup ;
+
+: ahead ( -- >mark ) >mark here 8 + always brif ;
+: if ( cond -- >mark ) >mark here 8 + rot -cond brif ;
+: then ( >mark -- ) >resolve ;
+: else ( >mark -- >mark1 ) ahead but then ;
+: begin ( -- <mark ) <mark ;
+: until ( <mark cond -- ) -cond brif ;
+: again ( <mark -- ) always brif ;
+: repeat ( >mark <mark -- ) again then ;
+: while ( <mark cond -- >mark <mark ) if but ;
+
+\ previous definitions
+
+previous definitions
+
+[ifdef] testing
+0 value expected
+
+order
+also forth definitions
+: test ( "address" "expected" "assembly-code" -- )
+ parse-word $number abort" bad address" is aoffset
+ parse-word $number abort" bad code" is expected
+ parse-word $assemble newword expected <> if
+ ." oops!! expected " expected .x ." got " newword .x cr
+ else
+ ." ."
+ then
+;
+
+: testloop clear begin refill while test
+depth abort" Stack trash"
+repeat ;
+previous definitions
+[then]
+previous previous definitions
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/assem.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/basefw.bth
===================================================================
--- cpu/arm/basefw.bth (rev 0)
+++ cpu/arm/basefw.bth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,107 @@
+purpose: Load file for base firmware - no platform specifics
+\ See license at end of file
+
+dictionary: ${BP}/cpu/arm/build/tools.dic
+command: &armforth &dictionary &this
+build-now
+
+\ ' $report-name is include-hook
+
+create include-help \ Include help facility
+
+alias cfill fill
+fload ${BP}/ofw/core/ofwcore.fth \ Device tree and other OBP routines
+fload ${BP}/ofw/core/ofwfw.fth \ FirmWorks enhancements
+fload ${BP}/ofw/core/memops.fth \ Call memory node methods
+fload ${BP}/ofw/core/mmuops.fth \ Call MMU node methods
+\ : cfill fill ;
+
+fload ${BP}/cpu/arm/scc.fth \ System Control Coprocessor registers
+fload ${BP}/cpu/arm/traps.fth \ Exception handlers
+fload ${BP}/cpu/arm/psr.fth \ Special registers
+fload ${BP}/cpu/arm/getms.fth \ Timer access
+
+fload ${BP}/cpu/arm/centry.fth \ Low-level client entry and exit
+fload ${BP}/cpu/arm/fb8-ops.fth \ 8-bit frame buffer primitives
+
+fload ${BP}/ofw/confvar/loadcv.fth \ Configuration variables
+fload ${BP}/ofw/core/silentmd.fth \ NVRAM variable silent-mode?
+
+fload ${BP}/ofw/termemu/loadfb.fth \ Frame buffer support
+fload ${BP}/ofw/termemu/difont.fth \ Get font from a dropin module
+
+fload ${BP}/ofw/gui/alert.fth \ Basic dialogs and alerts
+fload ${BP}/dev/stringio.fth \ Output diversion
+
+fload ${BP}/ofw/core/loadmore.fth \ Load additional core stuff
+
+fload ${BP}/ofw/inet/loadtftp.fth \ Trivial File Transfer Protocol pkg.
+
+fload ${BP}/cpu/arm/forthint.fth \ Alarm handler
+
+fload ${BP}/cpu/arm/regacc.fth \ Register access words
+
+fload ${BP}/cpu/arm/memtest.fth \ Memory test primitives
+
+fload ${BP}/ofw/fcode/loadfcod.fth \ S Fcode interpreter
+
+fload ${BP}/ofw/fcode/regcodes.fth \ Register access words
+fload ${BP}/ofw/fcode/extcodes.fth \ Firmworks extension FCodes
+
+fload ${BP}/ofw/core/initprog.fth \ FCode and Forth source load formats
+
+fload ${BP}/ofw/core/infltdi.fth \ Support for compressed dropin drivers
+
+fload ${BP}/cpu/arm/initpgm.fth \ Basic boot handler
+
+[ifdef] resident-packages
+support-package: fat-file-system
+ fload ${BP}/ofw/fs/fatfs/loadpkg.fth \ FAT file system reader
+end-support-package
+
+support-package: iso9660-file-system
+ fload ${BP}/ofw/fs/cdfs/loadpkg.fth \ ISO 9660 CD-ROM file system reader
+end-support-package
+
+support-package: disk-label
+ fload ${BP}/ofw/disklabel/loadpkg.fth \ Disk label package
+end-support-package
+[then]
+
+[ifdef] resident-packages
+fload ${BP}/ofw/fs/fatfs/fdisk2.fth \ Partition map administration
+[else]
+autoload: fdisk2.fth
+defines: $.partitions
+defines: .partitions
+\ defines: init-nt-disk
+defines: $partition
+[then]
+
+[ifndef] no-heads
+.( --- Saving basefw.dic --- ) cr " basefw.dic" $save-forth
+[then]
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1994 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/basefw.bth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/bitops.fth
===================================================================
--- cpu/arm/bitops.fth (rev 0)
+++ cpu/arm/bitops.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,57 @@
+purpose: Bit operations
+\ See license at end of file
+
+hex
+code bitset ( bit# array -- )
+ mov r0,tos \ r0 array
+ ldmia sp!,{r1,tos} \ r1 bit#
+ and r2,r1,#7
+ mov r3,#0x80
+ ldrb r4,[r0,r1,asr #3]
+ orr r4,r4,r3,ror r2
+ strb r4,[r0,r1,asr #3]
+c;
+
+code bitclear ( bit# array -- )
+ mov r0,tos \ r0 array
+ ldmia sp!,{r1,tos} \ r1 bit#
+ and r2,r1,#7
+ mvn r3,#0x80
+ ldrb r4,[r0,r1,asr #3]
+ and r4,r4,r3,ror r2
+ strb r4,[r0,r1,asr #3]
+c;
+
+code bittest ( bit# array -- flag )
+ pop r1,sp \ r1 bit#
+ and r2,r1,#7
+ mov r3,#0x80
+ ldrb r4,[tos,r1,asr #3]
+ ands r4,r4,r3,ror r2
+ mvnne tos,#0
+ moveq tos,#0
+c;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/bitops.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/boot.fth
===================================================================
--- cpu/arm/boot.fth (rev 0)
+++ cpu/arm/boot.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,124 @@
+\ Contents: Boot-code for ARM Risc_OS Code
+\ See license at end of file
+
+hex
+nuser memtop \ The top of the memory used by Forth
+0 value #args \ The process's argument count
+0 value args \ The process's argument list
+
+0 constant main-task \ This pointer will be changed at boot
+
+code start-forth ( r6: header r7: syscall-vec r8: memtop )
+ ( r10: argc r11: argv r12: initial-heap-size )
+ \ Binary relocation. This code reads the relocation bitmap and
+ \ relocates each longword marked by a 1 bit in the bitmap. Each
+ \ bit in the bitmap represents an aligned address in the program
+ \ image, thus there is one relocation bit for each 32-bit word in
+ \ the program image. The bits in relocation bitmap are numbered
+ \ in big-endian order.
+ \ The 0x80 bit corresponds to a lower address than then 0x40 bit, etc.
+ add r0,r6,#0x80 \ forth-image
+ ldr r1,[r0,#0x10] \ /dictionary
+ ldr r3,[r0,#0x14] \ old origin
+ mov r2,r1,asr #2 \ words to relocate
+ add r1,r0,r1 \ dictionary size plus forth-image
+ cmp r3,r0
+ <> if
+ dec r2,#1
+ \ variables:
+ \ r0: The startof the program image
+ \ r1: The ending address of the program image,
+ \ equal to the starting address of the relocation bitmap
+ \ r2: bit-to-relocate
+ \ r3: origin at saving time
+
+ begin
+ and r4,r2,#7
+ mov r5,#0x80
+ mov r4,r5,lsr r4
+ ldrb r5,[r1,r2,asr #3]
+ ands r4,r4,r5
+ 0<> if
+ ldr r4,[r0,r2,lsl #2]
+ sub r4,r4,r3
+ add r4,r4,r0
+ str r4,[r0,r2,lsl #2]
+ then
+ subs r2,r2,#1
+ <= until
+ then
+
+ \ set user-pointer up
+
+ add up,r0,`init-user-area #` \ set user-pointer
+ str r1,'user dp \ set here
+
+ str r8,'user memtop
+ sub sp,r8,#0x40
+ \ Now the stacks are just below the end of our memory
+
+ ps-size-t rs-size-t + #
+ sub r8,r8,*
+ sub r8,r8,r12
+ str r8,'user limit
+
+ str r7,'user syscall-vec
+ str r10,'user #args
+ str r11,'user args
+
+ \ At this point, the stack pointer is at the top of the unused
+ \ memory and the user pointer has been set to the bottom of the
+ \ initial user area image.
+ str up,'user up0
+ str up,[pc,`'body main-task swap here 8 + - swap`]
+ mov rp,sp \ set return-stack pointer
+ str rp,'user rp0
+ rs-size-t 100 + #
+ dec sp,*
+ dec sp,#0x20
+ str sp,'user sp0
+ inc sp,1cell \ account for the top of stack register
+ adr ip,'body cold
+c;
+
+code cold-code ( r0: loadaddr r1: functions r2: memtop ... )
+ ( r3: argc sp[0]: argv )
+ here-t 8 put-call
+
+ \ Put the arguments in safe registers
+ mov r6,r0 \ r6 points to header
+ mov r7,r1 \ r7: functions
+ mov r8,r2 \ r8: memtop
+ \ r9 is up
+ mov r10,r3 \ r10: argc
+ ldr r11,[sp] \ r11: argv
+ mov r12,#0 \ r11: initial-heap-size
+
+ b 'code start-forth
+end-code
+
+: init-user ;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2006 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/boot.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/build/Makefile
===================================================================
--- cpu/arm/build/Makefile (rev 0)
+++ cpu/arm/build/Makefile 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,27 @@
+OS := $(shell uname)
+
+all: basefw.dic
+
+.PHONY: FORCE all clean
+
+.PRECIOUS: builder.dic
+
+../${OS}/forth:
+ @make -C ../${OS} forth
+
+build: ../${OS}/forth
+ @ln -sf ../${OS}/forth $@
+
+%.dic: FORCE build
+ ./build $@
+
+builder.dic: FORCE build
+ -[ ! -f builder.sav ] && cp builder.dic builder.sav
+ ./build builder.dic
+
+inflate.bin:
+ make -C ../${OS} ../build/inflate.bin
+
+# 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
Property changes on: cpu/arm/build/Makefile
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/builder.bth
===================================================================
--- cpu/arm/builder.bth (rev 0)
+++ cpu/arm/builder.bth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,10 @@
+purpose: Load file for i386 builder
+
+dictionary: ${BP}/cpu/arm/build/tools.dic
+command: &armforth &dictionary &this
+build-now
+
+fload ${BP}/ofw/tokenizer/tokenize.fth \ Tokenizer
+fload ${BP}/forth/lib/builder.fth \ Builder
+
+.( --- Saving builder.dic --- ) " builder.dic" $save-forth cr
Property changes on: cpu/arm/builder.bth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/call.fth
===================================================================
--- cpu/arm/call.fth (rev 0)
+++ cpu/arm/call.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,50 @@
+purpose: From Forth, call the C subroutine whose address is on the stack
+\ See license at end of file
+
+code sp-call ( [ arg5 .. arg0 ] adr sp -- [ arg5 .. arg0 ] result )
+ pop r6,sp \ Get the subroutine address
+
+ str sp,'user saved-sp \ Save for callbacks
+ psh ip,rp \ ARM Procedure Call Standard can clobber IP
+ str rp,'user saved-rp \ Save for callbacks
+
+ mov rp,#0 \ Set the frame pointer to null
+
+ \ Pass up to 6 arguments
+ ldmia sp,{r0,r1,r2,r3,r4,r5}
+
+ mov sp,tos \ Switch to the new stack
+
+ mov lk,pc \ Set link register to return address
+ mov pc,r6 \ Call the subroutine
+
+ ldr rp,'user saved-rp \ Restore the return stack pointer
+ pop ip,rp \ Restore IP
+ ldr sp,'user saved-sp \ Restore the stack pointer
+ mov tos,r0 \ Return subroutine result
+c;
+: call ( [ arg5 .. arg0 ] adr -- [ arg5 .. arg0 ] result ) sp@ sp-call ;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/call.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/centry.fth
===================================================================
--- cpu/arm/centry.fth (rev 0)
+++ cpu/arm/centry.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,75 @@
+purpose: Client interface handler code
+\ See license at end of file
+
+d# 11 /n* buffer: cif-reg-save
+
+headerless
+code cif-return
+ mov r0,tos
+ ldr r1,'user cif-reg-save \ Address of register save area in r1
+ ldmia r1,{r4,r5,r6,r7,r8,r9,r10,r11,r12,r13,pc} \ Restore registers
+end-code
+
+: cif-exec ( args ... -- ) do-cif cif-return ;
+
+headers
+: cif-caller ( -- adr ) cif-reg-save d# 84 + @ ;
+
+headerless
+label cif-handler
+ \ Registers:
+ \ r0 argument array pointer
+ \ r4-r14 must be preserved
+ \ r1-r3 scratch
+
+
+ adr r2,'body main-task
+ ldr r2,[r2] \ Get user pointer
+ ldr r1,[r2,`'user# cif-reg-save`] \ Address of register save area in r1
+ stmia r1,{r4,r5,r6,r7,r8,r9,r10,r11,r12,r13,r14} \ Save registers
+
+ mov up,r2 \ Set user pointer
+
+ mov tos,r0 \ Set top of stack register to arg
+
+ ldr rp,'user rp0 \ Set return stack pointer
+ ldr sp,'user sp0 \ Set data stack pointer
+ inc sp,1cell \ Account for the top of stack register
+
+ adr ip,'body cif-exec \ Set interpreter pointer
+c;
+
+0 value callback-stack
+
+headers
+: callback-call ( args vector -- ) callback-stack sp-call 2drop ;
+
+\ Force allocation of buffer
+stand-init: CIF buffers
+ cif-reg-save drop
+ h# 1000 dup alloc-mem + to callback-stack
+;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/centry.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/code.fth
===================================================================
--- cpu/arm/code.fth (rev 0)
+++ cpu/arm/code.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,160 @@
+purpose: Defining words for code definitions
+\ See license at end of file
+
+\ These words are specific to the virtual machine implementation
+: assembler ( -- ) arm-assembler ;
+
+only forth also arm-assembler also helpers also arm-assembler also definitions
+
+\ Forth Virtual Machine registers
+
+\ also register-names definitions
+\ Convenient register names for portable programming
+: base r7 ;
+: up r9 ;
+: tos r10 ;
+: rp r11 ;
+: ip r12 ;
+: sp r13 ;
+: lk r14 ;
+: lr r14 ;
+: pc r15 ;
+\ previous definitions
+
+\ also constant-names definitions
+\ also register-names definitions
+
+: asm-con: ( n "name" -- ) create , does> @ adt-immed ;
+/n asm-con: 1cell \ Offsets into the stack
+1cell drop -1 * asm-con: -1cell
+1cell drop -1 * asm-con: ~1cell
+1cell drop 2 * asm-con: 2cells
+1cell drop 3 * asm-con: 3cells
+1cell drop 4 * asm-con: 4cells
+
+1cell drop asm-con: /cf \ Size of a code field (except for "create")
+/cf drop -1 * asm-con: -/cf
+/cf drop -1 * asm-con: ~/cf
+
+1cell drop asm-con: /token \ Size of a compiled word reference
+/token drop -1 * asm-con: -/token
+/token drop -1 * asm-con: ~/token
+
+1cell drop asm-con: /branch \ Size of a branch offset
+
+/token drop 2 * asm-con: /ccf \ Size of a "create" code field
+
+/cf drop 1cell drop + asm-con: /cf+1cell \ Location of second half of
+previous definitions
+
+\ The next few words are already in the forth vocabulary;
+\ we want them in the assembler vocabulary too
+alias next next
+headerless
+: exitcode ( -- )
+ ['] $interpret-do-undefined is $do-undefined
+ previous
+;
+' exitcode is do-exitcode
+headers
+alias c; c;
+
+: set-offset ( offset -- ) d# 12 ?#bits iop ;
+: 'body ( "name" -- variable-apf adt-immed ) ' >body adt-immed ;
+: 'code ( "name" -- code-word-acf adt-immed ) ' adt-immed ;
+: 'user# ( "name" -- user# adt-immed ) ' >body @ adt-immed ;
+: 'user ( "name" -- )
+\ [ also register-names ] up [ previous ] drop ( reg# )
+ up drop rb-field
+ 'user# ( value adt-immed )
+ drop set-offset
+;
+\ lnk{cond}{s} rN
+\ is equivalent to
+\ mov{cond} rN,lk
+: lnk ( -- )
+\ [ also register-names ] lk [ previous ] drop ( reg# )
+ lk drop ( reg# )
+ 01a0.0000 or {cond/s} init-operands get-r12 !op
+;
+
+: (incdec) ( op-template -- )
+ {cond/s}
+ init-operands
+ get-register dup rd-field rb-field
+ get-opr2
+ !op
+;
+
+\ inc{cond}{s} rN,<immed>
+\ is equivalent to
+\ add{cond}{s} rN,rN,<immed>
+: inc ( -- ) 0080.0000 (incdec) ;
+
+\ dec{cond}{s} rN,<immed>
+\ is equivalent to
+\ sub{cond}{s} rN,rN,<immed>
+: dec ( -- ) 0040.0000 (incdec) ;
+
+: (pshpop) ( op-template -- ) {cond} init-operands get-r12 get-r16 !op ;
+\ psh{cond} rN,rM
+\ is equivalent to
+\ str{cond} rN,[rM,-1cell]!
+: psh ( -- ) 0520.0004 (pshpop) ;
+
+\ pop{cond} rN,rM
+\ is equivalent to
+\ ldr{cond} rN,[rM],1cell
+: pop ( -- ) 0490.0004 (pshpop) ;
+
+\ nxt{cond}
+\ is equivalent to
+\ mov{cond} pc,up
+: nxt ( -- )
+\ [ also register-names ] up [ previous ] drop ( reg# )
+ up drop
+ 01a0.f000 or {cond/s} init-operands !op
+;
+
+also forth definitions
+headerless
+: entercode ( -- )
+ also assembler
+\ false is disassembling?
+ [ also helpers ]
+ ['] $arm-assem-do-undefined is $do-undefined
+ [ previous ]
+;
+' entercode is do-entercode
+
+headers
+\ "code" is defined in the kernel
+
+: label \ name ( -- )
+ create !csp entercode
+;
+only forth also definitions
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2006 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/code.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/cpubpsup.fth
===================================================================
--- cpu/arm/cpubpsup.fth (rev 0)
+++ cpu/arm/cpubpsup.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,87 @@
+purpose: Processor-dependent definitions for breakpoints on ARM
+\ See license at end of file
+
+\ Machine-dependent definitions for breakpoints
+
+headerless
+defer breakpoint-trap?
+
+\ True if the exception was an undefined instruction
+: (breakpoint-trap? ( -- flag ) exception-psr h# 1f and h# 1b = ;
+' (breakpoint-trap? is breakpoint-trap?
+
+: op@ ( adr -- op ) l@ ;
+: op! ( op adr -- ) instruction! ;
+: bp-address-valid? ( adr -- flag ) 3 and 0= ;
+: at-breakpoint? ( adr -- flag ) op@ breakpoint-opcode = ;
+: put-breakpoint ( adr -- ) breakpoint-opcode swap op! ;
+
+headers
+: .instruction ( -- )
+ pc [ also disassembler ] dis-pc! dis1 [ previous ]
+;
+
+headerless
+\ Find the places to set the next breakpoint for single stepping.
+
+\ Flag is true if the branch should be followed - we don't follow branches
+\ if stepping? is false and the instruction is a "bl"
+: >b-target ( pc -- adr ) dup l@ 8 << 6 >>a + 8 + ;
+: bl? ( pc -- flag ) l@ h# 0f00.0000 and h# 0b00.0000 = ;
+: b? ( pc -- flag ) l@ h# 0e00.0000 and h# 0a00.0000 = ;
+
+: next-instruction ( stepping? -- next-adr branch-target|0 )
+ pc la1+ swap ( next-adr stepping? )
+
+ \ If we are hopping (not stepping), then we don't follow
+ \ branch-and-link instructions.
+ 0= pc bl? and if 0 exit then ( next-adr )
+
+ pc ( next-adr pc )
+ dup b? if >b-target exit then ( next-adr pc )
+ dup bl? if >b-target exit then ( next-adr pc )
+\ XXX need to handle all sorts of instructions with PC as the destination
+ drop 0
+;
+
+: bumppc ( -- ) pc la1+ to pc ;
+
+alias rpc pc
+
+: return-adr ( -- adr ) r11 l@ ;
+: leaf-return-adr ( -- adr ) lr ;
+
+: backward-branch? ( adr -- flag ) \ True if adr points to a backward branch
+ dup b? if dup >b-target u> exit then ( adr )
+ drop false
+;
+: loop-exit-adr ( -- adr )
+ pc begin dup backward-branch? 0= while la1+ repeat la1+
+;
+
+headers
+: set-pc ( adr -- ) to pc ;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1994 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/cpubpsup.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/cpustate.fth
===================================================================
--- cpu/arm/cpustate.fth (rev 0)
+++ cpu/arm/cpustate.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,42 @@
+purpose: Buffers for saving program state
+\ See license at end of file
+
+headers
+\ A place to save the CPU registers when we take a trap
+0 value cpu-state \ Pointer to CPU state save area
+
+headerless
+: >state ( offset -- adr ) cpu-state + ;
+
+\ Don't use buffer: for these because we may need to instantiate them
+\ before the buffer: mechanism has been initialized.
+0 value pssave \ Forth data stack save area
+0 value rssave \ Forth return stack save area
+
+headers
+defer .exception \ Display the exception type
+defer handle-breakpoint \ What to do after saving the state
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1985-1994 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/cpustate.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/ctrace.fth
===================================================================
--- cpu/arm/ctrace.fth (rev 0)
+++ cpu/arm/ctrace.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,102 @@
+purpose: Displays a backtrace of saved C stack frames.
+\ See license at end of file
+
+only forth also hidden also forth definitions
+: 9.r ( adr -- ) push-hex 9 u.r pop-base ;
+defer .subname ' 9.r is .subname
+
+: .subroutine ( lr -- ) \ Show soubroutine address
+ 4 - dup l@ h# 0f00.0000 and h# 0b00.0000 = if \ BAL instruction?
+ dup l@ 8 << 6 >>a + .subname exit
+ then
+ drop ." ??????" \ perhaps an indirect call
+;
+: .args ( -- ) \ Show C subroutine arguments
+ ." (" r0 9.r r1 9.r r2 9.r r3 9.r ." ... )"
+;
+: .c-call ( lr -- )
+ ." Subroutine " dup l@ .subroutine ." called from " 4 - .subname cr
+;
+: ctrace ( -- ) \ C stack backtrace
+\ XXX we should look at the first instruction in the subroutine
+\ to determine whether it is using the FP or non-FP protocol.
+\ Without an FP it will be rather tricky to find the saved PCs, but
+\ at least we might be able to avoid going off into the ozone.
+ push-hex
+ ." PC at " pc .subname cr
+ ." Last leaf: " lr .subroutine .args cr
+ ." Call-chain:" cr
+ r11 begin ( frame-pointer )
+ dup 0<> over in-return-stack? 0= and
+ while
+ >saved dup -1 l+ l@ .c-call
+ -3 la+ l@ ( next-fp )
+ repeat
+ pop-base
+;
+\ compiler options: /swst or /noswst
+\ Non-leaf:
+\ Preamble
+\ +0000 0x000080cc: 0xe1a0c00d .... : * mov r12,r13
+\ +0004 0x000080d0: 0xe92dd800 ..-. : stmdb r13!,{r11,r12,r14,pc}
+\ +0008 0x000080d4: 0xe24cb004 ..L. : sub r11,r12,#4
+\ SW stack checking goes here if enabled
+\ ...
+\ +000c 0x000080d8: 0xeb000001 .... : bl foo
+\ +0010 0x000080dc: 0xe3a00000 .... : mov r0,#0
+\ ...
+\ Postamble
+\ +0014 0x000080e0: 0xe91ba800 .... : ldmdb r11,{r11,r13,pc}
+
+\ The stack frame then looks like:
+\
+\ (previous SP) --->
+\ &code after preamble (i.e. entry-adr + 0xc)
+\ (new FP (r11))--->
+\ return address
+\ previous SP
+\ previous FP
+\ saved Rm
+\ ...
+\ saved Rn
+\ (new SP (r13))--->
+
+\ Leaf:
+\ foo
+\ +0000 0x000080e4: 0xe1a0f00e .... : mov pc,r14
+
+
+\ compiler options: /nofp
+\ main
+\ +0000 0x000080cc: 0xe92d4000 . at -. : stmdb r13!,{r14}
+\
+\ +0004 0x000080d0: 0xeb000001 .... : bl foo
+\ +0008 0x000080d4: 0xe3a00000 .... : mov r0,#0
+\
+\ +000c 0x000080d8: 0xe8bd8000 .... : ldmia r13!,{pc}
+\ foo
+\ +0000 0x000080dc: 0xe1a0f00e .... : mov pc,r14
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/ctrace.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/debugm.fth
===================================================================
--- cpu/arm/debugm.fth (rev 0)
+++ cpu/arm/debugm.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,86 @@
+purpose: Machine-dependent support routines for Forth debugger.
+\ See license at end of file
+
+hex
+
+headerless
+\ It doesn't matter what address this returns because it is only used
+\ as an argument to slow-next and fast-next, which do nothing.
+: low-dictionary-adr ( -- adr ) origin ( init-user-area + ) ;
+
+nuser debug-next \ Pointer to "next"
+vocabulary bug bug also definitions
+nuser 'debug \ code field for high level trace
+nuser <ip \ lower limit of ip
+nuser ip> \ upper limit of ip
+nuser cnt \ how many times thru debug next
+
+\ Since we use a shared "next" routine, slow-next and fast-next are no-op's
+alias slow-next 2drop ( high low -- )
+alias fast-next 2drop ( high low -- )
+
+label normal-next
+ ldr pc,[ip],1cell
+end-code
+
+label debnext
+ ldr r0,'user <ip
+ cmp ip,r0
+ u>= if
+ ldr r0,'user ip>
+ cmp ip,r0
+ u< if
+ ldr r0,'user cnt
+ inc r0,#1
+ str r0,'user cnt
+ cmp r0,#2
+ = if
+ mov r0,#0
+ str r0,'user cnt
+ adr r0,'body normal-next
+ str r0,'user debug-next
+ ldr pc,'user 'debug
+ then
+ then
+ then
+ ldr pc,[ip],1cell
+end-code
+
+\ Fix the next routine to use the debug version
+: pnext ( -- )
+ [ also arm-assembler ]
+ debnext up@ put-branch
+ [ previous ]
+;
+
+\ Turn off debugging
+: unbug ( -- ) normal-next @ up@ instruction! ;
+
+headers
+
+forth definitions
+unbug
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/debugm.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/decompm.fth
===================================================================
--- cpu/arm/decompm.fth (rev 0)
+++ cpu/arm/decompm.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,48 @@
+purpose: Machine/implementation-dependent decompiler support
+\ See license at end of file
+
+headerless
+
+only forth also hidden also definitions
+: dictionary-base ( -- adr ) up@ user-size + ;
+
+\ True if adr is a reasonable value for the interpreter pointer
+: reasonable-ip? ( adr -- flag )
+ dup in-dictionary? if ( ip )
+ #talign 1- and 0= \ must be token-aligned
+ else
+ drop false
+ then
+;
+
+\ Decompiler extension for 32-bit literals
+: .llit ( ip -- ip' ) ta1+ dup l@ n. la1+ ;
+: skip-llit ( ip -- ip' ) ta1+ la1+ ;
+' (llit) ' .llit ' skip-llit install-decomp
+
+only forth also definitions
+headers
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1994 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/decompm.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/disassem.fth
===================================================================
--- cpu/arm/disassem.fth (rev 0)
+++ cpu/arm/disassem.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,430 @@
+purpose: ARM disassembler - prefix syntax
+\ See license at end of file
+
+vocabulary disassembler
+also disassembler also definitions
+
+headerless
+
+variable instruction
+variable end-found
+variable display-offset 0 display-offset !
+headers
+variable dis-pc
+: (pc@ ( -- adr ) dis-pc @ ;
+defer dis-pc@ ' (pc@ is dis-pc@
+: (pc! ( adr -- ) dis-pc ! ;
+defer dis-pc! ' (pc! is dis-pc!
+: pc at l@ ( -- opcode ) dis-pc @ l@ ;
+headerless
+
+defer regs
+
+string-array (real-regs
+," r0" ," r1" ," r2" ," r3"
+," r4" ," r5" ," r6" ," r7"
+," r8" ," r9" ," r10" ," r11"
+," r12" ," r13" ," link" ," pc"
+end-string-array
+: real-regs ['] (real-regs is regs ;
+
+string-array (forth-regs
+," r0" ," r1" ," r2" ," r3"
+," r4" ," r5" ," r6" ," r7"
+," r8" ," up" ," tos" ," rp"
+," ip" ," sp" ," lr" ," pc"
+end-string-array
+: forth-regs ['] (forth-regs is regs ;
+forth-regs
+
+: udis. ( n -- )
+ push-hex
+ <#
+ u# u# u# u# u# u# u# u#
+ u#> type pop-base
+;
+' udis. is showaddr
+
+: +offset ( adr -- adr' ) display-offset @ - ;
+: >mask ( #bits -- mask ) 1 swap << 1- ;
+: bits ( right-bit #bits -- field )
+ instruction @ rot >> ( #bits shifted-instruction )
+ swap >mask and ( field )
+;
+: 4bits ( right-bit -- field ) 4 bits ;
+: bit? ( bit# -- f ) instruction @ 1 rot lshift and 0<> ;
+\ Extracts an index from the field "bit# #bits", indexes into the string
+\ "adr len", which is assumed to contain substrings of length /entry,
+\ and types the indexed substring.
+: .fld ( bit# #bits adr len /entry -- )
+ >r drop >r ( bit# #bits r: /entry adr )
+ bits ( index r: /entry adr )
+ r> swap r@ * + r> ( adr' /entry )
+ type
+;
+
+\ Display formatting
+variable start-column
+: op-col ( -- ) start-column @ d# 8 + to-column ;
+
+: .reg ( bit# -- ) 4bits regs ". ;
+: {<cond>} ( -- )
+ d# 28 4bits d# 14 = if exit then
+ d# 28 4 " eqnecsccmiplvsvchilsgeltgtle nv" 2 .fld
+;
+
+: ., ( -- ) ." , " ;
+: .[ ( -- ) ." [" ;
+: .] ( -- ) ." ]" ;
+
+: .rm ( -- ) 0 .reg ;
+: .rs ( -- ) 8 .reg ;
+: .rd, ( -- ) d# 12 .reg ., ;
+: op.rd, ( -- ) op-col .rd, ;
+: .rb ( -- ) d# 16 .reg ;
+alias .rn .rb
+
+: .rm,shift ( -- )
+ .rm
+ d# 4 8 bits if \ LSL #0 is no-shift; this isn't it
+ .,
+ 4 8 bits 6 = if ." rrx" exit then
+ 5 2 " lsllsrasrror" 3 .fld ." "
+ 4 bit? if .rs else ." #" 7 5 bits .d then
+ then
+;
+
+: u.h ( n -- ) dup d# 9 u> if ." 0x" then (u.) type ;
+: ror ( n cnt -- ) 2dup d# 32 swap - lshift -rot rshift or ;
+: .imm ( -- ) 0 8 bits 8 4bits 2* ror u.h ;
+
+: ?.bit ( adr len bit# -- ) bit? if type else 2drop then ;
+
+d# 20 constant d#20
+d# 21 constant d#21
+d# 22 constant d#22
+d# 23 constant d#23
+d# 24 constant d#24
+d# 25 constant d#25
+
+: {s} ( -- ) " s" d#20 ?.bit ;
+: {!} ( -- ) " !" d#21 ?.bit ;
+: {^} ( -- ) " ^" d#22 ?.bit ;
+: {b} ( -- ) " b" d#22 ?.bit ;
+: +/- ( -- ) d#23 bit? 0= if ." -" then ;
+
+: .r/imm ( -- )
+ d#25 bit? if ." #" .imm else .rm,shift then
+;
+\ Indicates the form of the instruction that affects both PC and CPSR/SPSR
+: {p} ( -- )
+ d#23 2 bits 3 = if \ MOV class
+ d# 12 4bits h# f = if ." p" then \ Rd is PC
+ then
+;
+: .alu ( -- )
+ d#21 4 " andeorsubrsbaddadcsbcrsctstteqcmpcmnorrmovbicmvn" 3 .fld
+ {<cond>}
+;
+: alu# ( -- n ) d#21 4bits ;
+\ control instruction extension space
+\ exceptions are encoded as tests with no setting of the condition codes
+\ OOIo oooS Rn/b Rd Rs shft Rm
+\ 00I1 0oo0
+\ BX{<cond>} Rm cond 0001 0010 SBO SBO SBO 0001 Rm
+\ MSR{<cond>} xPSR, y cond 00x1 0R10 fsxc SBO yyyy yyyy yyyy
+\ MRS{<cond>} Rd, xPSR cond 0001 0R00 SBO Rd SBZ
+
+: .psr ( -- ) d#22 bit? if ." s" else ." c" then ." psr" ;
+: .fields ( -- )
+ ." _" " cxsf" drop d# 16 4bits ( adr mask )
+ 4 0 do dup 1 and if over i + c@ emit then 2/ loop
+ 2drop
+;
+: .mrs/sr ( -- )
+ d#21 bit? if \ MSR
+ ." msr" {<cond>}
+ op-col .psr .fields ., .r/imm
+ else \ MRS
+ ." mrs" {<cond>} op.rd, .psr
+ then
+;
+: .special ( -- )
+ instruction @ h# 026f.fff0 and h# 002f.ff10 = if
+ ." bx" {<cond>} op-col .rm
+ exit
+ then
+ .mrs/sr
+;
+
+\ Arithmetic instruction extension space
+: .alu-ext ( -- )
+ d#23 bit? if \ 64-bit multiply
+ d#21 2 " umullumlalsmullsmlal" 5 .fld {<cond>} {s}
+ op-col .rn ., .rd, .rs ., .rm
+ else \ 32-bit multiply
+ d#21 2 " mulmla??????" 3 .fld {<cond>} {s}
+ op-col .rb ., .rm ., .rs
+ instruction @ h# 00200000 and if ., d# 12 .reg then
+ then
+;
+: w-bit ( -- flag ) d#21 bit? ;
+: p-bit ( -- flag ) d#24 bit? ;
+
+\ LD/ST extension space
+\ SWP{<cond>} Rd, Rm, [Rn] cond 0001 00ZZ Rn Rd SBZ 1001 Rm
+\ LDR{<cond>}{H|SH|SB} Rd, Rm, [Rn] cond 000P UBW1 Rn Rd addr 1SH1 addr
+\ STR{<cond>}{H|SH|SB} Rd, Rm, [Rn] cond 000P UBW0 Rn Rd addr 1SH1 addr
+: imm8 ( -- n ) 8 4bits 4 lshift 0 4bits or ;
+: ,.r/imm8 ( -- )
+ d#22 bit? if
+ imm8 if ., ." #" +/- imm8 u.h then
+ else
+ ., +/- .rm
+ then
+;
+: .ld/st ( -- ) d#20 bit? if ." ld" else ." st" then ;
+: .ldx ( -- )
+ .ld/st ." r" {<cond>} " s" 6 ?.bit " h" 5 ?.bit
+ op.rd,
+ .[ .rn p-bit if ,.r/imm8 .] {!} else .] ,.r/imm8 then
+;
+: .swp ( -- ) ." swp" {<cond>} " b" d#22 ?.bit op.rd, .rm ., .[ .rn .] ;
+
+: .ld/st-ext ( -- ) 5 2 bits if .ldx else .swp then ;
+
+: .ext ( -- ) \ Extension space
+ d#24 bit? 0= 5 2 bits 0= and if .alu-ext else .ld/st-ext then
+;
+
+\ Stop after changing PC
+: ?pc-change ( -- ) d# 12 4bits d# 15 = end-found ! ;
+
+: .alu-op ( -- ) \ d# 25 3 bits 0|1 =
+ 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
+ ?pc-change
+ exit
+ then
+ d#23 2 bits 2 = if \ Compares
+ d#20 bit? 0= if .special exit then
+ .alu op-col .rn ., .r/imm
+ exit
+ then
+ .alu {s} op.rd, .rn ., .r/imm
+;
+: .swi ( -- ) ." swi" op-col 0 d#24 bits u.h ;
+
+\ XXX handle muls they have 9 in the 4 4bits field, swp is one of them
+\ : ^ ( -- ) 00400000 op-or ; \ ldm stm PSR or force user-mode registers
+\ : # ( -- ) 02000000 op-or ; \ last operand is immediate
+\ : s ( -- ) 00100000 op-or ; \ flags are set according to result
+\ : t ( -- ) 00200000 op-or ; \ ldr str force -T pin
+\ : 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,? )
+ if ." , " then true ( n need,?' )
+ i regs ". ( n need,? )
+ then ( n need,? )
+ swap 2/ swap ( n need,?' )
+ loop ( n need,?' )
+ 2drop ( )
+ ." }" ( )
+;
+: .inc ( -- ) d#23 2 " daiadbib" 2 .fld ;
+: .ldm/stm ( -- ) \ d# 25 3 bits 4 =
+ .ld/st ." m" {<cond>} .inc
+ op-col .rb {!} ., .mregs {^}
+ d# 15 bit? d# 20 bit? and end-found ! \ Stop after PC change
+;
+: {t} ( -- ) p-bit 0= w-bit and if ." t" then ;
+: imm12 ( -- n ) 0 d# 12 bits ;
+: ,.addr-mode ( -- )
+ d#25 bit? if
+ ., +/- .rm,shift
+ else
+ imm12 if ., ." #" +/- imm12 u.h then
+ then
+;
+: .ldr/str ( -- ) \ d# 25 3 bits 2|3 =
+ 0 d# 28 bits h# 0e00.0010 and h# 0600.0010 = if
+ ." undefined" {<cond>}
+ exit
+ then
+ .ld/st ." r" {<cond>} {b} {t}
+ op.rd, .[ .rb
+ p-bit if ,.addr-mode .] {!} else .] ,.addr-mode then
+ ?pc-change
+;
+: .branch ( -- ) \ d# 25 3 bits 5 =
+ ." b" " l" d#24 ?.bit {<cond>}
+ d#24 bit? end-found !
+
+ op-col dis-pc@ 8 + 0 d#24 bits 8 << 6 >>a + +offset showaddr
+;
+
+: n.d ( n -- ) push-decimal <# u#s u#> type pop-base ;
+: .creg ( bit# -- ) 4bits ." cr" n.d ;
+[ifdef] dis-fp
+: .ldf/stf ( -- ) \ d# 25 3 bits 6 =
+ .ld/st ." f" ???
+;
+: .flt ( -- ) \ d# 25 3 bits 7 =
+ d#20 2 " fltfixwfsrfs" 3 .fld op-col .precision
+;
+XXX decode floating opcodes:
+ 0 8 fops adf mvf muf mnf suf abs rsf rnd
+ 8 8 fops dvf sqt rdf log pow lgn rpw exp
+10 8 fops rmf sin fml cos fdv tan frd asn
+18 4 fops pol acs ??? atn
+[then]
+: p# ( -- n ) 8 4bits ;
+: .p#, ( n -- ) ." p" p# n.d ., ;
+: .offset8 ( -- ) ." #" +/- 0 8 bits 4 * u.h ;
+: .ldc/stc ( -- )
+ .ld/st ." c" {<cond>} " l" d#22 ?.bit
+ op-col .p#, d# 12 .creg ., .[ .rn
+ p-bit if ., .offset8 .] {!} else .] ., .offset8 then
+;
+: .cptail ( -- ) d# 16 .creg ., 0 .creg ., 5 3 bits n.d ;
+
+\ Decode I/D Branch-Target/Write-Buffer Flush/Clean /Entry bits
+\ for ARM4 Cache and TLB control registers
+: .flushes ( -- )
+ 7 bit? if
+ 6 bit? if
+ ." Flush Branch Target"
+ else
+ 0 bit? if ." Flush Prefetch" else ." Drain Write" then
+ ." Buffer"
+ then
+ else
+ " Clean " 3 ?.bit " Flush " 2 ?.bit " I" 0 ?.bit " D" 1 ?.bit
+ then
+ " entry" 5 ?.bit
+;
+: .clocks ( -- ) \ For SA-110
+ 5 bit? if
+ 0 4bits case
+ 1 of ." Enable odd word loading of Icache LFSR" cr endof
+ 2 of ." Enable even word loading of Icache LFSR" cr endof
+ 4 of ." Clear Icache LFSR" endof
+ 8 of ." Move LFSR to R14.Abort" endof
+ endcase
+ else
+ 0 4bits case
+ 1 of ." Enable clock switching" endof
+ 2 of ." Disable clock switching" endof
+ 4 of ." Disable nMCLK output" endof
+ 8 of ." Wait for interrupt" endof
+ endcase
+ then
+;
+string-array scc-regs
+ ," ID"
+ ," Control"
+ ," TTBase"
+ ," Domain"
+ ," ?"
+ ," FaultStatus"
+ ," FaultAddress"
+ ," Cache"
+ ," TLB"
+ ," ?"
+ ," ?"
+ ," ?"
+ ," ?"
+ ," ?"
+ ," ?"
+ ," Test/Clock/Idle" \ SA-110
+end-string-array
+: .scc ( -- ) \ Decode ARM4 system control coprocessor register ops
+ \ Opcode1 should be 0
+ ." p15(SCC), 0, " .rd,
+ d# 16 .creg ." (" d# 16 4 bits dup scc-regs ". ." )" ( cr# )
+ dup 7 8 between if drop ., .flushes exit then
+ d# 15 = if .clocks then \ SA-110
+;
+: .coproc ( -- )
+ p-bit if .swi exit then
+ d# 4 bit? if \ MRC and MCR
+ d# 20 1 " mcrmrc" 3 .fld {<cond>}
+ op-col
+ p# d# 15 = if \ System Control Coprocessor
+ .scc
+ else
+ .p#, d# 21 3 bits n.d ., .rd, .cptail
+ then
+ else \ CDP
+ ." cdp" {<cond>}
+ op-col .p#, d# 20 4bits n.d ., d# 12 .creg ., .cptail
+ then
+;
+
+create classes
+ ['] .alu-op compile, \ 0
+ ['] .alu-op compile, \ 1 (immediate)
+ ['] .ldr/str compile, \ 2
+ ['] .ldr/str compile, \ 3 (immediate)
+ ['] .ldm/stm compile, \ 4
+ ['] .branch compile, \ 5
+ ['] .ldc/stc compile, \ 6
+ ['] .coproc compile, \ 7
+
+: disasm ( x -- )
+ push-hex
+ instruction !
+ classes d#25 3 bits ta+ token@ execute
+ pop-base
+;
+
+headers
+forth definitions
+alias disasm disasm
+: dis1 ( -- )
+ ??cr
+ dis-pc@ +offset showaddr ." : " pc at l@ udis. ." "
+ #out @ start-column !
+ pc at l@ disasm cr
+ /l dis-pc@ + dis-pc!
+;
+: +dis ( -- )
+ end-found off
+ begin dis1 end-found @ exit? or until
+;
+: dis ( adr -- ) dis-pc! +dis ;
+
+headerless
+alias (dis dis
+headers
+
+previous previous definitions
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/disassem.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/dodoesad.fth
===================================================================
--- cpu/arm/dodoesad.fth (rev 0)
+++ cpu/arm/dodoesad.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,32 @@
+purpose: Defined dodoesaddr at the appropropriate place
+\ See license at end of file
+
+\ dodoesaddr cannot be defined in KERNCODE because the user area is
+\ initialized after KERNCODE.
+\ This file should be loaded after uservars.fth
+
+tuser dodoesaddr
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2006 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/dodoesad.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/extra.fth
===================================================================
--- cpu/arm/extra.fth (rev 0)
+++ cpu/arm/extra.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,130 @@
+purpose: Additional kernel code words
+\ See license at end of file
+
+hex
+
+code (llit) ( -- lit ) psh tos,sp ldmia ip!,{tos,pc} c;
+
+code perform ( adr -- ) ldr r0,[tos] pop tos,sp mov pc,r0 end-code
+
+code hash ( str-adr voc-ptr -- thread )
+ pop r0,sp \ string
+ ldrb r0,[r0,#1]
+ #threads-t 1- #
+ and r0,r0,*
+ ldr tos,[tos,1cell] \ get user#
+ add tos,tos,up \ Get thread base address
+ add tos,tos,r0,lsl #2
+c;
+
+\ Starting at "link", which is the address of a memory location
+\ containing a link to the acf of a word in the dictionary, find the
+\ word whose name matches the string "adr len", returning the link
+\ field address of that word if found.
+
+\ Assumes the following header structure - [N] is size in bytes:
+\ pad[0-3] name-characters[n] name-len&flags[1] link[4] code-field[4]
+\ ^ ^ ^
+\ anf alf acf
+\ The link field points to the *code field* of the next word in the list.
+\ Padding is added, if necessary, before the name characters so that
+\ acf is aligned on a 4-byte boundary.
+
+code ($find-next) ( adr len link -- adr len alf true | adr len false )
+ \ !!!! the next line should ONLY be included for RiscOS Forthmacs testing
+\ adr base,'body origin
+ ldr base,[pc,`'body origin swap here 8 + - swap`]
+ ldr r5,[tos] \ link is kept in r5
+ mov tos,#0 \ false is the default return value
+
+\ cmp r5,#0 \ ?exit if link=BASE
+ cmp r5,base \ ?exit if link=BASE
+ nxteq
+ begin
+\ add r5,r5,base \ r5 absolute adr
+ dec r5,1cell \ r5 at linkfield
+ sub r2,r5,#1 \ r2 set to len/flag-adr
+ ldrb r0,[r2]
+ ands r0,r0,#0x1f \ r0: mask len of $find-next
+ 0<> if
+ ldmia sp,{r3,r4} \ r3 len; r4 adr
+
+ cmp r3,r0 \ both strings have same len?
+ 0= if
+ sub r2,r2,r3 \ r2: adr of potential $find-next
+ begin
+ decs r3,#1
+ >= while
+ ldrb r0,[r4],#1
+ ldrb r1,[r2],#1 \ compare one char each
+ cmp r0,r1 \ comm: CAPS not tested ?
+ 0<> until then
+ cmn r3,#1 \ all characters tested?
+ 0= if
+ psh r5,sp \ push link-adr ...
+ mvn tos,#0 \ ... and true
+ next
+ then
+ then
+ then
+ ldr r5,[r5]
+ cmp r5,BASE \ link = BASE ?
+ 0= until
+c;
+
+[ifdef] notdef
+code l+ ( l1 l2 -- l3 ) pop r0,sp add tos,tos,r0 c;
+code l- ( l1 l2 -- l3 ) pop r0,sp rsb tos,tos,r0 c;
+
+code lnegate ( l -- -l ) rsb tos,tos,#0 c;
+
+code labs ( l -- [l] ) cmp tos,#0 rsbmi tos,tos,#0 c;
+
+code l2/ ( l -- l/2 ) mov tos,tos,asr #1 c;
+
+code lmin ( l1 l2 -- l1|l2 ) pop r0,sp cmp tos,r0 movgt tos,r0 c;
+code lmax ( l1 l2 -- l1|l2 ) pop r0,sp cmp r0,tos movgt tos,r0 c;
+[then]
+
+code s->l ( n -- l ) c;
+code l->n ( l -- n ) c;
+code n->a ( n -- a ) c;
+code l->w ( l -- w ) mov tos,tos,lsl #16 mov tos,tos,lsr #16 c;
+code n->w ( n -- w ) mov tos,tos,lsl #16 mov tos,tos,lsr #16 c;
+
+code l>r ( l -- ) psh tos,rp pop tos,sp c;
+code lr> ( -- l ) psh tos,sp pop tos,rp c;
+
+#align-t constant #align
+#acf-align-t constant #acf-align
+#talign-t constant #talign
+
+: align ( -- ) #align (align) ;
+: taligned ( adr -- adr' ) #talign round-up ;
+: talign ( -- ) #talign (align) ;
+
+: wconstant ( "name" w -- ) header constant-cf , ;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/extra.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/fb8-ops.fth
===================================================================
--- cpu/arm/fb8-ops.fth (rev 0)
+++ cpu/arm/fb8-ops.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,249 @@
+purpose: fb8 package support routines
+\ See license at end of file
+
+\ Rectangular regions are defined by "adr width height bytes/line".
+\ "adr" is the address of the upper left-hand corner of the region.
+\ "width" is the width of the region in pixels (= bytes, since
+\ this is the 8-bit-per-pixel package). "height" is the height of the
+\ region in scan lines. "bytes/line" is the distance in bytes from
+\ the beginning of one scan line to the beginning of the next one.
+
+\ Within the rectangular region, replace bytes whose current value is
+\ the same as fg-color with bg-color, and vice versa, leaving bytes that
+\ match neither value unchanged.
+code fb8-invert ( adr width height bytes/line fg-color bg-color -- )
+ mov r0,tos
+ ldmia sp!,{r1,r2,r3,r4,r5,tos}
+ \ r0:bg-colour r1:fg-colour r2:bytes/line r3:height r4:width r5:adr
+
+ begin
+ cmp r3,#0
+ > while
+ mov r6,#0
+ begin
+ cmp r4,r6 \ more pixels/line?
+ > while
+ ldrb r7,[r5,r6] \ get pixel colour at adr+offset
+ cmp r7,r0
+ streqb r1,[r5,r6]
+ cmp r7,r1
+ streqb r0,[r5,r6]
+ inc r6,#1
+ repeat
+ add r5,r5,r2
+ dec r3,#1
+ repeat
+c;
+
+\ Within the rectangular region, replace halfwords whose current value is
+\ the same as fg-color with bg-color, and vice versa, leaving bytes that
+\ match neither value unchanged.
+code fb16-invert ( adr width height bytes/line fg-color bg-color -- )
+ mov r0,tos
+ ldmia sp!,{r1,r2,r3,r4,r5,tos}
+ \ r0:bg-colour r1:fg-colour r2:bytes/line r3:height r4:width r5:adr
+
+ begin
+ cmp r3,#0
+ > while
+ mov r6,#0
+ begin
+ cmp r4,r6 \ more pixels/line?
+ > while
+ ldrh r7,[r5,r6] \ get pixel colour at adr+offset
+ cmp r7,r0
+ streqh r1,[r5,r6]
+ cmp r7,r1
+ streqh r0,[r5,r6]
+ inc r6,#2
+ repeat
+ add r5,r5,r2
+ dec r3,#1
+ repeat
+c;
+
+\ Within the rectangular region, replace halfwords whose current value is
+\ the same as fg-color with bg-color, and vice versa, leaving bytes that
+\ match neither value unchanged.
+code fb32-invert ( adr width height bytes/line fg-color bg-color -- )
+ mov r0,tos
+ ldmia sp!,{r1,r2,r3,r4,r5,tos}
+ \ r0:bg-colour r1:fg-colour r2:bytes/line r3:height r4:width r5:adr
+
+ begin
+ cmp r3,#0
+ > while
+ mov r6,#0
+ begin
+ cmp r4,r6 \ more pixels/line?
+ > while
+ ldr r7,[r5,r6] \ get pixel colour at adr+offset
+ cmp r7,r0
+ streq r1,[r5,r6]
+ cmp r7,r1
+ streq r0,[r5,r6]
+ inc r6,#4
+ repeat
+ add r5,r5,r2
+ dec r3,#1
+ repeat
+c;
+
+
+\ Draws a character from a 1-bit-deep font into an 8-bit-deep frame buffer
+\ Font bits are stored 1-bit-per-pixel, with the most-significant-bit of
+\ the font byte corresponding to the leftmost pixel in the group for that
+\ byte. "font-width" is the distance in bytes from the first font byte for
+\ a scan line of the character to the first font byte for its next scan line.
+code fb8-paint
+ ( fontadr fontbytes width height screenadr bytes/line fg-color bg-color -- )
+ ldmia sp!,{r1,r2,r3,r4,r5,r6,r7}
+ psh r9,sp
+\ tos:bg-col r1:fg-col r2:bytes/line r3: screeadr r4:height r5:width
+\ r6:font-width r7:fontadr
+\ free: r8 r9 r0
+ begin
+ cmp r4,#0
+ > while
+ mov r8,#0 \ r8: pixel-offset
+ begin
+ cmp r5,r8 \ one more pixel?
+ > while
+ ldrb r9,[r7,r8,lsr #3] \ r9 fontdatabyte
+ and r0,r8,#7
+ rsb r0,r0,#8
+ movs r0,r9,asr r0
+ strcsb r1,[r3,r8]
+ strccb tos,[r3,r8]
+ inc r8,#1
+ repeat
+ add r7,r7,r6 \ new font-line
+ add r3,r3,r2 \ new screen-line
+ dec r4,#1
+ repeat
+ ldmia sp!,{r9,tos}
+c;
+
+\ Draws a character from a 1-bit-deep font into a 16bpp frame buffer
+\ Font bits are stored 1-bit-per-pixel, with the most-significant-bit of
+\ the font byte corresponding to the leftmost pixel in the group for that
+\ byte. "font-width" is the distance in bytes from the first font byte for
+\ a scan line of the character to the first font byte for its next scan line.
+code fb16-paint
+ ( fontadr fontbytes width height screenadr bytes/line fg-color bg-color -- )
+ ldmia sp!,{r1,r2,r3,r4,r5,r6,r7}
+ psh r9,sp
+\ tos:bg-col r1:fg-col r2:bytes/line r3: screeadr r4:height r5:width
+\ r6:font-width r7:fontadr
+\ free: r8 r9 r0
+ begin
+ cmp r4,#0
+ > while
+ mov r8,#0 \ r8: pixel-offset
+ begin
+ cmp r5,r8 \ one more pixel?
+ > while
+ ldrb r9,[r7,r8,lsr #3] \ r9 fontdatabyte
+ and r0,r8,#7
+ rsb r0,r0,#8
+ movs r0,r9,asr r0
+ strcsh r1,[r3,r8]
+ strcch tos,[r3,r8]
+ inc r8,#2
+ repeat
+ add r7,r7,r6 \ new font-line
+ add r3,r3,r2 \ new screen-line
+ dec r4,#1
+ repeat
+ ldmia sp!,{r9,tos}
+c;
+
+\ Draws a character from a 1-bit-deep font into an 8-bit-deep frame buffer
+\ Font bits are stored 1-bit-per-pixel, with the most-significant-bit of
+\ the font byte corresponding to the leftmost pixel in the group for that
+\ byte. "font-width" is the distance in bytes from the first font byte for
+\ a scan line of the character to the first font byte for its next scan line.
+code fb32-paint
+ ( fontadr fontbytes width height screenadr bytes/line fg-color bg-color -- )
+ ldmia sp!,{r1,r2,r3,r4,r5,r6,r7}
+ psh r9,sp
+\ tos:bg-col r1:fg-col r2:bytes/line r3: screeadr r4:height r5:width
+\ r6:font-width r7:fontadr
+\ free: r8 r9 r0
+ begin
+ cmp r4,#0
+ > while
+ mov r8,#0 \ r8: pixel-offset
+ begin
+ cmp r5,r8 \ one more pixel?
+ > while
+ ldrb r9,[r7,r8,lsr #3] \ r9 fontdatabyte
+ and r0,r8,#7
+ rsb r0,r0,#8
+ movs r0,r9,asr r0
+ strcs r1,[r3,r8]
+ strcc tos,[r3,r8]
+ inc r8,#4
+ repeat
+ add r7,r7,r6 \ new font-line
+ add r3,r3,r2 \ new screen-line
+ dec r4,#1
+ repeat
+ ldmia sp!,{r9,tos}
+c;
+
+\ Similar to 'move', but only moves width out of every 'bytes/line' bytes
+\ "size" is "height" times "bytes/line", i.e. the total length of the
+\ region to move.
+
+\ bytes/line is a multiple of 8, src-start and dst-start are separated by
+\ a multiple of bytes/line (i.e. src and dst are simililarly-aligned), and
+\ src > dst (so move from the start towards the end). This makes it
+\ possible to optimize an assembly language version to use longword or
+\ doubleword operations.
+
+\ this assumes width to be also a multiple of 8
+code fb-window-move ( src-start dst-start size bytes/line width -- )
+ mov r0,tos
+ ldmia sp!,{r1,r2,r3,r4,tos}
+ \ r0:width r1: bytes/line r2:size r3:dst-start r4:src-start
+ sub r1,r1,r0 \ r1:bytes/line - width
+ add r2,r2,r4 \ r2:end-of-src-copy-region
+ begin
+ cmp r4,r2
+ < while
+ mov r7,r0 \ r7:loop-width
+ begin
+ decs r7,#8
+ ldmgeia r4!,{r5,r6}
+ stmgeia r3!,{r5,r6}
+ < until
+
+ add r4,r4,r1
+ add r3,r3,r1
+ repeat
+c;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/fb8-ops.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/field.fth
===================================================================
--- cpu/arm/field.fth (rev 0)
+++ cpu/arm/field.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,39 @@
+purpose: Defining words for structures and fields
+\ See license at end of file
+
+\ field creates words which add their offset within the structure
+\ to the base address of the structure
+
+: struct ( -- 0 ) 0 ;
+
+: field ( "name" offset size -- offset+size )
+ create over , +
+ ;code ( struct-adr -- field-adr )
+ lnk r0
+ ldr r0,[r0]
+ add tos,tos,r0
+c;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2006 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/field.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/filecode.fth
===================================================================
--- cpu/arm/filecode.fth (rev 0)
+++ cpu/arm/filecode.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,205 @@
+purpose: Code words to support the file system interface
+\ See license at end of file
+
+decimal
+
+\ signed mixed mode addition
+code ln+ ( l n -- l ) \ same as l+ or =
+ pop r0,sp
+ add tos,tos,r0
+c;
+
+\ &ptr is the address of a pointer. fetch the pointed-to character and
+\ post-increment the pointer.
+code @c at ++ ( &ptr -- char )
+ mov r0,tos
+ ldr r1,[r0]
+ ldrb tos,[r1],#1
+ str r1,[r0]
+c;
+
+\ &ptr is the address of a pointer. store the character into
+\ the pointed-to location and post-increment the pointer
+code @c!++ ( char &ptr -- )
+ ldmia sp!,{r0,r2}
+ ldr r1,[tos]
+ strb r0,[r1],#1
+ str r1,[tos]
+ mov tos,r2
+c;
+
+: cindex ( adr len char -- [ adr' true ] | false )
+ false swap 2swap bounds ?do ( false char )
+ dup i c@ = if nip i true rot leave then
+ loop ( false char | adr' true char )
+ drop
+;
+
+[ifdef] notdef
+\ "adr1 len2" is the longest initial substring of the string "adr1 len1"
+\ that does not contain the character "char". "adr2 len1-len2" is the
+\ trailing substring of "adr1 len1" that is not included in "adr1 len2".
+\ Accordingly, if there are no occurrences of that character in "adr1 len1",
+\ "len2" equals "len1", so the return values are "adr1 len1 adr1+len1 0"
+
+: split-string ( adr1 len1 char -- adr1 len2 adr1+len2 len1-len2 )
+ >r 2dup r> cindex if ( adr1 len1 adr1+len2 )
+ dup 3 pick - ( adr1 len1 adr1+len2 len2 )
+ rot over - ( adr1 adr1+len2 len2 len1-len2 )
+ >r swap r>
+ else ( adr1 len1 )
+ 2dup + 0
+ then
+;
+
+\ : xxsplit-string ( adr1 len1 char -- adr1 len2 adr1+len2 len1-len2 )
+\ over 0= if \ degenerate
+\ drop 2dup exit
+\ then
+\ >r 2dup over + swap ( adr1 len1 adr1+len1 adr1 )
+\ begin
+\ 2dup u> while ( adr1 len1 adr1+len1 adr )
+\ count r@ = if \ found it! ( adr1 len1 adr1+len1 adr' )
+\ 1- nip 2 pick - ( adr1 len1 len2 )
+\ tuck - >r 2dup + r> ( adr1 len2 adr1+len2 len1-len2 )
+\ r> drop exit
+\ then ( adr1 len1 adr1+len1 adr )
+\ repeat ( adr1 len1 adr1+len1 adr )
+\ 2drop 2dup + 0
+\ ;
+
+
+\ Splits a buffer into two parts around the first line delimiter
+\ sequence. A line delimiter sequence is either CR, LF, CR followed by LF,
+\ or LF followed by CR.
+\ adr1 len2 is the initial substring before, but not including,
+\ the first line delimiter sequence.
+\ adr2 len3 is the trailing substring after, but not including,
+\ the first line delimiter sequence.
+decimal
+: parse-line ( adr1 len1 -- adr1 len2 adr2 len3 )
+ 2dup d# 10 cindex if \ has lf ( adr1 len1 adr-lf )
+ >r 2dup d# 13 cindex if \ has cr ( adr1 len1 adr-cr )
+ r> umin ( adr1 len1 adr-delim )
+ else \ lf only
+ r> ( adr1 len1 adr-delim )
+ then ( adr1 len1 adr-delim )
+ else \ no lf ( adr1 len1 )
+ 2dup d# 13 cindex if \ has cr ( adr1 len1 adr-cr )
+ else \ neither
+ 2dup + 0 exit
+ then
+ then ( adr1 len1 adr-delim )
+ dup 3 pick - -rot 1+ swap ( adr1 len2 adr2 len1 )
+ 2 pick - 1-
+;
+[else]
+\ "adr1 len2" is the longest initial substring of the string "adr1 len1"
+\ that does not contain the character "char". "adr2 len1-len2" is the
+\ trailing substring of "adr1 len1" that is not included in "adr1 len2".
+\ Accordingly, if there are no occurrences of that character in "adr1 len1",
+\ "len2" equals "len1", so the return values are "adr1 len1 adr1+len1 0"
+code split-string ( adr1 len1 char -- adr1 len2 adr1+len2 len1-len2 )
+ ldmia sp!,{r3,r4} \ r3: len1 r4: adr1
+ mov r1,r4 \ r1: adr1
+ add r2,r3,r4 \ r2: lastchar of string
+ mvn r0,#0
+ begin
+ cmp r1,r2
+ < while
+ ldrb r0,[r1],#1 \ getchar - postincr
+ cmp r0,tos
+ 0= until then
+ cmp r0,tos \ delimiter was found
+ deceq r1,#1 \ last non-delimiter character adr
+ \ r1: adr1 r2: *lastchar+1
+ sub r2,r1,r4 \ r2: len2
+ sub tos,r3,r2
+ add r1,r4,r2 \ r1: adr1+len2
+ stmdb sp!,{r4,r2,r1}
+c;
+
+\ Splits a buffer into two parts around the first line delimiter
+\ sequence. A line delimiter sequence is either CR, LF, CR followed by LF,
+\ or LF followed by CR.
+\ adr1 len2 is the initial substring before, but not including,
+\ the first line delimiter sequence.
+\ adr2 len3 is the trailing substring after, but not including,
+\ the first line delimiter sequence.
+code parse-line ( adr1 len1 -- adr1 len2 adr2 len3 )
+ ldr r4,[sp],1cell \ r4 adr
+ mov r1,r4 \ r1 abs adr1
+ add r2,r1,tos \ r2 abs lastchar
+ mvn r0,#0
+
+ begin
+ cmp r1,r2
+ < while
+ ldrb r0,[r1],#1
+ cmp r0,#10
+ cmpne r0,#13
+ 0= until then
+ sub r3,r1,r4 \ r3 len2
+ cmp r0,#10
+ cmpne r0,#13
+ deceq r3,1 \ correct r3
+ cmp r1,r2 \ more chars in line?
+ < if
+ ldrb tos,[r1]
+ cmp tos,#10
+ cmpne tos,#13
+ = if
+ cmpeq tos,r0 \ not the same delimiter
+ incne r1,#1
+ then
+ then
+ sub tos,r2,r1
+ stmdb sp!,{r4,r3,r1}
+c;
+[then]
+
+nuser delimiter
+
+nuser file
+
+:-h struct ( -- 0 ) 00 ;-h
+
+\ header-t (file-field)
+code-field: dofield ( -- fd+offset )
+ psh tos,sp
+ lnk r0
+ ldr r0,[r0]
+ ldr tos,'user file
+ add tos,tos,r0
+c;
+
+:-h file-field-cf ( -- ) dofield place-cf-t ;-h
+
+\ Assembles the code field when metacompiling a field
+:-h file-field ( "name" offset size -- offset )
+ " file-field-cf" header-t over ,-t + ?debug
+;-h
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2006 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/filecode.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/finish.fth
===================================================================
--- cpu/arm/finish.fth (rev 0)
+++ cpu/arm/finish.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,39 @@
+purpose: Final steps of the kernel metacompilation process
+\ See license at end of file
+
+hex
+' init is do-init
+\ ' warm-hook ' 'lastacf >user-t token!-t
+
+assembler dodoes meta is dodoesaddr
+forth-h
+
+metaoff
+
+only forth also definitions
+
+' symbols fixall
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2006 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/finish.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/float.fth
===================================================================
--- cpu/arm/float.fth (rev 0)
+++ cpu/arm/float.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,409 @@
+purpose: Forth floating point package for ARM FPU/FPE
+\ See license at end of file
+
+\ Contributed by Hanno Schwalm
+\ Implements ths ANS Forth floating and floating extended package.
+\ needs Fothmacs V. 3.1/2.12 or higher
+\ All floating point numbers are IEEE double-precision format
+\ using a seperate floating stack assigned by a user variable fp.
+
+only forth also arm-assembler also definitions
+
+: popf0 s" r7 'user fp ldr f0 r7 popf r7 'user fp str" evaluate ;
+: popf1 s" r7 'user fp ldr f1 r7 popf r7 'user fp str" evaluate ;
+: popf2 s" r7 'user fp ldr f2 r7 popf r7 'user fp str" evaluate ;
+: pushf0 s" r7 'user fp ldr f0 r7 pushf r7 'user fp str" evaluate ;
+: pushf1 s" r7 'user fp ldr f1 r7 pushf r7 'user fp str" evaluate ;
+: pushf2 s" r7 'user fp ldr f2 r7 pushf r7 'user fp str" evaluate ;
+
+only forth also system also definitions hex
+
+code @fs ( -- n ) \ get the floating status
+ top sp push
+ top rfs
+ top top 0f # and c;
+code !fs ( n -- ) \ set the floating status
+ r1 top 0f # and
+ top sp pop
+ r0 rfs
+ r0 r0 ff00 # and
+ r0 r0 r1 orr
+ r0 wfs c;
+
+nuser fbuff /float 2* ualloc drop
+: @sign ( -- f) fbuff @ 80000000 and 0<> ;
+: @esign ( -- f) fbuff @ 40000000 and 0<> ;
+: !sign ( f ) 0<> 80000000 and fbuff @ 4fffffff and or fbuff ! ;
+: !esign ( f ) 0<> 40000000 and fbuff @ 8fffffff and or fbuff ! ;
+: @nibble ( #nibb -- n2 )
+ 8 /mod swap >r cells fbuff + @ 7 r> - 4* rshift 0f and ;
+: !nibble ( #nibb n )
+ swap 8 /mod swap >r cells fbuff + ( n addr r: n-th )
+ f0000000 r@ 4* rshift -1 xor ( n addr mask r: n-th )
+ over @ and ( n addr ncont R: n-th )
+ rot 7 r> - 4* lshift or swap ! ;
+
+decimal
+
+: @exp 0 5 1 do 10 * i @nibble + loop @esign ?negate 1+ ;
+: @dig 5 + @nibble [char] 0 + ;
+
+code !flpd \ ( addr -- )
+ popf0
+ packed f0 top 3 cells ia stf double
+ top sp pop c;
+\ a packed decimal is read at addr and written to the floating stack
+code @flpd ( addr -- )
+ packed f0 top 3 cells ia ldf double
+ pushf0
+ top sp pop c;
+
+: fp-error
+ @fs 0 !fs
+ dup 2 and if -42 throw then
+ dup 13 and if -43 throw then
+ 16 and if -41 throw then abort ;
+
+arm-assembler definitions
+: c;fl \ ends a floating point code definitions with checking for errors
+ r0 rfs r0 r0 h# 0f # s and eq next ip ['] fp-error >body adr c; ;
+
+forth definitions
+: (cold-hook 0 !fs (cold-hook ; ' (cold-hook is cold-hook
+
+\ often used floating high precision constants
+code -.5E0 f0 #0.5 mnf pushf0 c;
+code -1E0 f0 #1.0 mnf pushf0 c;
+code -2E0 f0 #2.0 mnf pushf0 c;
+code -3E0 f0 #3.0 mnf pushf0 c;
+code -4E0 f0 #4.0 mnf pushf0 c;
+code -5E0 f0 #5.0 mnf pushf0 c;
+code -1E1 f0 #10.0 mnf pushf0 c;
+code 0E0 f0 #0.0 mvf pushf0 c;
+code .5E0 f0 #0.5 mvf pushf0 c;
+code 1E0 f0 #1.0 mvf pushf0 c;
+code 2E0 f0 #2.0 mvf pushf0 c;
+code 3E0 f0 #3.0 mvf pushf0 c;
+code 4E0 f0 #4.0 mvf pushf0 c;
+code 5E0 f0 #5.0 mvf pushf0 c;
+code 1E1 f0 #10.0 mvf pushf0 c;
+
+code f+ ( f1 f2 -- f3 ) popf0 popf1 f0 f1 f0 adf pushf0 c;fl
+code f- ( f1 f2 -- f3 ) popf0 popf1 f0 f1 f0 suf pushf0 c;fl
+code f* ( f1 f2 -- f3 ) popf0 popf1 f0 f1 f0 muf pushf0 c;fl
+code f/ ( f1 f2 -- f3 ) popf0 popf1 f0 f1 f0 dvf pushf0 c;fl
+code f** ( f1 f2 -- f3 ) popf0 popf1 f0 f1 f0 pow pushf0 c;fl
+code fmod ( f1 f2 -- f3 ) popf0 popf1 f0 f1 f0 rmf pushf0 c;fl
+code fsin ( f1 -- f2 ) popf0 f0 f0 sin pushf0 c;fl
+code fasin ( f1 -- f2 ) popf0 f0 f0 asn pushf0 c;fl
+code fcos ( f1 -- f2 ) popf0 f0 f0 cos pushf0 c;fl
+code fsincos ( f1 -- f2 f3 ) popf0 f1 f0 sin f2 f0 cos pushf0 pushf1 c;fl
+code facos ( f1 -- f2 ) popf0 f0 f0 acs pushf0 c;fl
+code ftan ( f1 -- f2 ) popf0 f0 f0 tan pushf0 c;fl
+code fatan ( f1 -- f2 ) popf0 f0 f0 atn pushf0 c;fl
+code fln ( f1 -- f2 ) popf0 f0 f0 lgn pushf0 c;fl
+code flnp1 ( f1 -- f2 ) popf0 f0 f0 #1.0 adf f0 f0 lgn pushf0 c;fl
+code flog ( f1 -- f2 ) popf0 f0 f0 log pushf0 c;fl
+code falog ( f1 -- f2 ) popf0 f0 #10.0 f0 pow pushf0 c;fl
+code fsqrt ( f1 -- f2 ) popf0 f0 f0 sqt pushf0 c;fl
+code fexp ( f1 -- f2 ) popf0 f0 f0 exp pushf0 c;fl
+code fexpm1 ( f1 -- f2 ) popf0 f0 f0 exp f0 f0 #1.0 suf pushf0 c;fl
+code fabs ( f1 -- absf1 ) popf0 f0 f0 abs pushf0 c;fl
+code fnegate ( f1 -- -f1 ) popf0 f0 f0 mnf pushf0 c;fl
+code floor ( f1 -- f2 ) popf0 -infinity f0 f0 rnd nearest pushf0 c;fl
+code fround ( f1 -- f2 ) popf0 f0 f0 rnd pushf0 c;fl
+code fhyp ( f1 -- 1/f1) popf0 f0 f0 #1.0 rdf pushf0 c;fl
+code sf@ ( sf-addr ) ( f: --sf )
+ single f0 top popf
+ double pushf0
+ top sp pop c;fl
+code sf!
+ double popf0
+ single f0 top pushf
+ double top sp pop c;fl
+
+: facosh ( f1 -- f2 ) fhyp facos ;
+: fasinh ( f1 -- f2 ) fhyp fasin ;
+: fatan2 ( f1 f2 -- f3 ) f/ fatan ;
+: fatanh ( f1 -- f2 ) fhyp fatan ;
+: fsinh ( f1 -- f2 ) fsin fhyp ;
+: ftanh ( f1 -- f2 ) ftan fhyp ;
+
+
+code f< ( f1 f2 -- | f )
+ top sp push popf1 popf0
+ f0 f1 cmfe
+ top -1 # lt mov top 0 # ge mov c;fl
+code f> ( f1 f2 -- | f )
+ top sp push popf1 popf0
+ f0 f1 cmfe
+ top -1 # gt mov top 0 # le mov c;fl
+code f= ( f1 f2 -- | f)
+ top sp push popf1 popf0
+ f0 f1 cmf
+ top -1 # eq mov top 0 # ne mov c;fl
+code f<> ( f1 f2 -- | f)
+ top sp push popf1 popf0
+ f0 f1 cmf
+ top -1 # ne mov top 0 # eq mov c;fl
+code f0= top sp push popf0
+ f0 #0.0 cmfe
+ top -1 # eq mov top 0 # ne mov c;fl
+code f0< top sp push popf0
+ f0 #0.0 cmfe
+ top -1 # lt mov top 0 # ge mov c;fl
+code f0> top sp push popf0
+ f0 #0.0 cmfe
+ top -1 # gt mov top 0 # le mov c;fl
+
+code fdup ( f1 -- f1 f1 )
+ r2 'user fp ldr
+ r0 r1 2 r2 ia ldm
+ r0 r1 2 r2 db! stm
+ r2 'user fp str c;
+code fdrop ( f1 -- )
+ r0 'user fp ldr
+ r0 2 cells incr
+ r0 'user fp str c;
+code fswap ( f1 f2 -- f2 f1 )
+ r4 'user fp ldr
+ r0 r1 r2 r3 4 r4 ia! ldm
+ r0 r1 2 r4 db! stm
+ r2 r3 2 r4 db! stm c;
+code frot ( f1 f2 f3 -- f2 f3 f1 )
+ r6 'user fp ldr
+ r0 r1 r2 r3 r4 r5 6 r6 ia! ldm
+ r2 r3 2 r6 db! stm
+ r4 r5 2 r6 db! stm
+ r0 r1 2 r6 db! stm c;
+code f-rot ( f1 f2 f3 -- f3 f1 f2 )
+ r6 'user fp ldr
+ r0 r1 r2 r3 r4 r5 6 r6 ia! ldm
+ r4 r5 2 r6 db! stm
+ r0 r1 r2 r3 4 r6 db! stm c;
+code f2dup ( f1 f2 -- f1 f2 f1 f2 )
+ r6 'user fp ldr
+ r0 r1 r2 r3 4 r6 ia ldm
+ r0 r1 r2 r3 4 r6 db! stm
+ r6 'user fp str c;
+code fover ( f1 f2 -- f1 f2 f1 )
+ r6 'user fp ldr
+ r2 r6 /float # add
+ r0 r1 2 r2 ia ldm
+ r0 r1 2 r6 db! stm
+ r6 'user fp str c;
+code n>f ( n -- ) \ n is converted to a float
+ f0 top flt
+ pushf0
+ top sp pop c;
+code f>n ( -- n ) \ takes a float and converts it to n
+ popf0
+ top sp push
+ top f0 fix c;
+code fmin popf0 popf1
+ f0 f1 cmfe
+ 0< if pushf0 else pushf1 then c;fl
+code fmax popf0 popf1
+ f0 f1 cmfe
+ 0> if pushf0 else pushf1 then c;fl
+
+code f~ ( f: f1 f2 f3 -- ) ( -- flag )
+ popf2 popf1 popf0
+ top sp push
+ top 0 # mov
+ f2 #0.0 cmfe
+gt if f3 f0 f1 suf
+ f3 f3 abs
+ f3 f2 cmfe
+ top -1 # lt mov
+ else f2 #0.0 cmf
+ eq if f0 f2 cmf
+ top -1 # eq mov
+ else f3 f0 abs
+ f4 f1 abs
+ f3 f3 f4 adf
+ f3 f3 f2 muf
+ f0 f0 f1 suf
+ f0 f0 abs
+ f0 f3 cmfe
+ top -1 # lt mov
+ then
+ then c;fl
+
+: d>f ( d -- ) ( f: -- f-d )
+ dup 0< >r dabs ?dup
+ if n>f [ 2E0 32 n>f f** ] fliteral f* else 0E0 then
+ dup h# 7fffffff and n>f f+
+ h# 80000000 and if [ 2E0 31 n>f f** ] fliteral f+ then
+ r> if fnegate then ;
+: f>d 0 !fs fdup f>n @fs
+ if drop 0 !fs
+ fdup f0< >r fabs fdup [ 2E0 32 n>f f** fdup ]
+ fliteral fmod f>n fliteral f/ f>n r> ?dnegate
+ else fdrop s>d
+ then ;
+: fdepth fp0 @ fp@ - 3 rshift ;
+
+: represent \ ( c-addr cnt -- exponent sign ok? )
+ 2dup [char] 0 fill
+ 19 min fbuff !flpd
+ @fs b# 1101 and if drop 0 false exit then
+ dup 19 < over 19 min @dig [char] 4 > and
+ ( c-addr cnt round )
+ -rot 1- 0 swap
+ do over i @dig swap
+ if 1+ dup [char] 9 >
+ if drop [char] 0 else rot drop 0 -rot then
+ then
+ over i + c!
+ -1 +loop
+ @exp swap
+ rot if [char] 1 swap c! 1+ else drop then
+ @sign true ;
+: >float \ ( addr u -- flag )
+ 0 !fs fbuff 3 cells erase
+ over c@ [char] - = dup !sign if next-char then
+ over c@ [char] + = if next-char then
+ begin over c@ [char] 0 = while next-char repeat
+ over 0 2swap 2dup bounds
+ ( c-addr c-len e-addr e-len to-char from-char )
+ ?do next-char i c@ [char] E <> if 2swap char+ 2swap else leave then
+ loop ( f-addr f-len e-addr e-len )
+ \ now the floating-number string has been split into the digits
+ \ and the exponent part
+ \ first the exponent is calculated
+ over c@ [char] - = dup >r if next-char then
+ over c@ [char] + = if next-char then
+ 0. 2swap >number
+ if r> 3drop 3drop false exit else 2drop r> ?negate then >r
+ \ exponent is left on the return-stack
+ \ skip leading nulls
+ begin over c@ [char] 0 = while next-char repeat
+ \ look for exponent correction
+ 2dup -1 -rot bounds ?do i c@ [char] . = ?leave 1+ loop r> + >r
+ over c@ [char] . = \ skip leading dots or nulls
+ if next-char begin over c@ [char] 0 = while r> 1- >r next-char repeat
+ then
+ r@ 0< !esign r> abs 1 4 do 10 /mod i rot !nibble -1 +loop drop
+ ( f-addr f-len )
+ 5 -rot bounds ( nibble to from )
+ ?do i c@ [char] 0 [char] 9 between if dup i c@ [char] 0 - !nibble 1+ then
+ loop drop
+ fbuff @flpd @fs 0= 0 !fs ;
+
+: fdigit? ( char -- flag )
+ dup [char] 0 [char] 9 between ( char flag )
+ over [char] E = or over [char] . = or
+ over [char] + = or swap [char] - = or ;
+: fnumber? ( string -- string false | f true )
+ true over count bounds ( string true to from )
+ ?do i c@ fdigit? 0= if drop false leave then loop
+ if dup count >float if drop true else false then
+ else false
+ then ;
+: float, ( f -- ) here /float allot f! ;
+
+
+: fvariable create /float allot ;
+: fconstant create float,
+ ;code
+ r7 get-link
+ r0 r1 2 r7 ia ldm
+ r2 'user fp ldr
+ r0 r1 2 r2 db! stm
+ r2 'user fp str c;
+
+3 actions" obj. floatval"
+ action: f@ ;
+ action: f! ;
+ action: ;
+: floatval \ ( F: f1 -- )
+ create here /float allot f!
+ use-actions ;
+
+alias falign align
+alias faligned aligned
+alias df! f!
+alias df@ f@
+alias dfalign align
+alias dfaligned aligned
+alias sfalign align
+alias sfaligned aligned
+alias dfloat+ float+
+alias dfloats floats
+alias sfloat+ cell+
+alias sfloats cells
+
+5 constant precision
+: set-precision ( n -- )
+ 1 max 250 min is precision ;
+: fs. ( f: r -- )
+ astring dup precision represent ( buffer exponent sign ok? )
+ 0= if fp-error then
+ if ." -" then >r dup c@ emit ." ." char+ precision 1- type
+ ." E" r> 1- .d ;
+: fe. ( f: r -- )
+ astring dup precision represent ( buffer exponent sign ok? )
+ 0= if fp-error then
+ if ." -" then 1+ >r
+ dup r@ 1+ 3 mod 1+ dup >r type ." ." r@ + precision r> - type
+ ." E" r> 1+ 3 / 1- 3 * .d ;
+: f. ( f: r -- )
+ astring dup precision represent ( buffer exponent sign ok? )
+ 0= if fp-error then
+ if ." -" then dup 0<=
+ if ." 0." abs 0 ?do ." 0" loop precision type
+ else 2dup type ." ." tuck + swap precision - dup 0< ( addr cnt f )
+ if abs type else 2drop ." 0" then
+ then ;
+: .fs ( -- ) \ displays floating stack
+ fp0 @
+ begin /float - dup fp@ >=
+ while dup f@ fs.
+ repeat drop ;
+
+: floats-on ['] fnumber? is fliteral? ;
+: floats-off ['] false is fliteral? ;
+
+floats-on
+environment: floating true ;
+environment: floating-ext true ;
+environment: floating-stack [ fs-size /float / ] literal ;
+environment: max-float 1.79769313486231571E+308 ;
+3.1415926535897932384E0 fconstant PI
+floats-off
+
+
+\ floating point decompiler support
+[ifdef] see
+ only forth also hidden also definitions
+ : .finline (s ip -- ip' ) cell+ dup f@ fs. cell+ cell+ ;
+ : skip-finline (s ip -- ip' ) cell+ float+ ;
+ ' (flit) ' .finline ' skip-finline install-decomp
+[then]
+
+only forth also definitions
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2008 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/float.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/forthint.fth
===================================================================
--- cpu/arm/forthint.fth (rev 0)
+++ cpu/arm/forthint.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,176 @@
+purpose: Low-level handler for alarm interrupt
+\ See license at end of file
+
+headerless
+
+\ Interfaces to system-dependent routines
+defer set-tick-limit ( #msecs -- ) \ Setup tick interrupt source
+defer init-dispatcher ( -- )
+defer dispatch-interrupt ' noop to dispatch-interrupt
+
+0 value intsave
+h# 1300 constant /intstack
+
+\ The interrupt save/stack area is laid out as follows:
+\ 0000 - register save area (size h#44)
+\ 0044 - data stack area (size h#1100-h#44)
+\ 1100 - return stack area (size h#200)
+\ 1300 - <end>
+\
+\ The register save area, which is exported to the client program via the
+\ "tick" callback, contains the following registers, all from the interrupted
+\ context:
+\ 00 - psr
+\ 04 - r0
+\ 08 - r1
+\ ...
+\ 38 - r13 (sp)
+\ 3c - r14 (lr)
+\ 40 - r15 (pc)
+\
+\ When the interrupt handler returns, the complete context is restored from
+\ the save area. The client program can cause a context switch by modifying
+\ these saved valued.
+
+hex
+
+: ?call-os ( -- ) intsave " tick" ($callback1) ;
+
+code interrupt-return ( -- )
+
+ \ At the first indication of a keyboard abort, we branch to the
+ \ Forth entry trap handler. We do the actual branch after we have
+ \ restored all the state, so it appears as if Forth were entered
+ \ directly from the program that was running, rather than through
+ \ the interrupt handler.
+
+ mov r3,#0 \ Clear derived abort flag
+ ldr r5,'user aborted? \ Abort flag
+
+ cmp r5,#1
+ = if
+ \ Don't abort in the middle of the terminal emulator, because
+ \ it's not reentrant.
+
+ ldr r4,'user terminal-locked?
+ cmp r4,#0
+
+ \ Increment the abort flag past 1 so that we won't see it again
+ \ until the interpreter has seen and cleared it.
+ inceq r5,#1
+ streq r5,'user aborted?
+ mvneq r3,#0 \ Set derived abort flag
+ then
+
+ mov r13,r3 \ Put derived flag in a safe place
+
+ ldr r0,'user intsave \ Address of interrupt save area
+
+ ldr r1,[r0] \ Saved SPSR from offset 0
+ msr spsr,r1 \ Restore it
+
+ mrs r2,cpsr \ Remember the current mode
+ tst r1,#0xf \ Check for user mode
+ orreq r1,r1,#0xf \ Set system mode if mode was user
+ orr r1,r1,#0x80 \ Disable interrupts
+ msr cpsr,r1 \ Sneak into the other mode
+
+ ldr r13,[r0,#56] \ Restore old SP
+ ldr r14,[r0,#60] \ Restore old LR
+ msr cpsr,r2 \ Return to the interrupt mode
+
+ ldr r14,[r0,#64] \ Restore PC to LR
+
+ ldmib r0,{r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11,r12}
+
+ \ Now the registers are back to the state that existed upon entry to
+ \ the interrupt handler. We can use only r13 in the following code.
+
+ cmp r13,#0 \ Test abort flag
+ moveqs pc,r14 \ Return from interrupt
+
+ adr r13,'body main-task \ Get user pointer address
+ ldr r13,[r13] \ Get user pointer
+ ldr r13,[r13,`'user# cpu-state`] \ State save address
+
+ stmia r13,{r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11,r12}
+
+ mov r0,r13 \ Move cpu-state pointer into r0
+ mvn r4,#0 \ Set r4 to -1 to indicate a user abort
+ b 'body save-common
+end-code
+
+: interrupt-handler dispatch-interrupt interrupt-return ;
+
+label interrupt-preamble
+\ here also hidden hwbp previous
+ adr r13,'body main-task \ Get user pointer address
+ ldr r13,[r13] \ Get user pointer
+ ldr r13,[r13,`'user# intsave`] \ Address of interrupt save area
+
+ stmib r13,{r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11,r12}
+ mov r0,r13 \ Switch to r0 for the save pointer
+
+ mrs r1,spsr
+ str r1,[r0] \ Save SPSR at offset 0
+ dec r14,#4 \ Account for pipeline
+ str r14,[r0,#64] \ Save PC at offset 64
+
+ \ Sneak into the old mode to pick up its r13 and r14
+ mrs r2,cpsr \ Remember the current mode
+ tst r1,#0xf \ Check for user mode
+ orreq r1,r1,#0xf \ Set system mode if mode was user
+ orr r1,r1,#0x80 \ Disable interrupts
+ msr cpsr,r1 \ Get into the old mode
+
+ str r13,[r0,#56] \ Save old SP
+ str r14,[r0,#60] \ Save old LR
+ msr cpsr,r2 \ Return to the interrupt mode
+
+ \ Set up Forth stacks
+ add rp,r0,`/intstack #` \ Return stack pointer
+ sub sp,rp,#0x204 \ Data stack pointer (w/top of stack)
+
+ adr up,'body main-task \ Get user pointer address
+ ldr up,[up] \ Get user pointer
+
+ adr ip,'body interrupt-handler
+c;
+
+: install-alarm ( -- )
+ /intstack alloc-mem to intsave
+ intsave /intstack erase \ Paranoia
+ disable-interrupts
+ [ also hidden ]
+ interrupt-preamble 6 install-handler
+ init-dispatcher
+ [ previous ]
+ d# 10 set-tick-limit
+ enable-interrupts \ Turn interrupts on
+;
+
+headers
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/forthint.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/ftrace.fth
===================================================================
--- cpu/arm/ftrace.fth (rev 0)
+++ cpu/arm/ftrace.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,33 @@
+purpose: Display a Forth stack backtrace
+\ See license at end of file
+
+only forth also hidden also forth definitions
+: ftrace ( -- ) \ Forth stack
+ ip >saved .traceline
+ rp >saved rssave-end swap (rstrace
+;
+only forth also definitions
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/ftrace.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/getms.fth
===================================================================
--- cpu/arm/getms.fth (rev 0)
+++ cpu/arm/getms.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,77 @@
+purpose: Interval timing functions
+\ See license at end of file
+
+headerless
+
+0 value tick-msecs
+: (get-msecs) ( -- n ) tick-msecs ;
+' (get-msecs) to get-msecs
+
+d# 10 value ms/tick
+d# 78,764 constant ms-factor
+0 value us-factor
+
+code spins ( count -- )
+ cmp tos,#0
+ <> if
+ begin
+ subs tos,tos,#1
+ 0= until
+ then
+ pop tos,sp
+c;
+: 1ms ( -- ) ms-factor spins ;
+
+: us ( #microseconds -- ) us-factor * spins ;
+
+: (ms) ( #ms -- )
+ dup ms/tick 3 * u> interrupts-enabled? and if ( #ms )
+ \ For relatively long durations, we use the ticker because it is
+ \ presumed to be reasonably accurate over the long run. However,
+ \ if interrupts are not enabled, we can't use the ticker because
+ \ it won't be ticking.
+
+ get-msecs + ( target )
+
+ \ We use "- 0<" instead of "<" so that the right thing will happen
+ \ when the tick count wraps around.
+ \ We use "0<" instead of "0<=" so that we are sure to wait at least
+ \ the requested time; otherwise we might not wait long enough if the
+ \ first call to get-msecs were to occur just before the timer ticked.
+ begin dup get-msecs - 0<= until \ Loop until target time reached
+
+ drop ( )
+ else ( #ms )
+ \ For relatively short durations, we use a timing loop because
+ \ the ticker probably has rather coarse granularity.
+
+ 0 ?do ms-factor spins loop
+ then
+;
+' (ms) to ms
+
+headers
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/getms.fth
___________________________________________________________________
Added: svn:executable
+ *
Property changes on: cpu/arm/inflate
___________________________________________________________________
Added: svn:executable
+ *
Added: svn:mime-type
+ application/octet-stream
Added: cpu/arm/inflater.fth
===================================================================
--- cpu/arm/inflater.fth (rev 0)
+++ cpu/arm/inflater.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,35 @@
+purpose: Inflater in the dictionary
+\ See license at end of file
+
+headerless
+create (inflater) " ${BP}/cpu/arm/inflate" $file,
+
+: (got-inflater) (inflater) 0 to inflater ;
+' (got-inflater) to get-inflater
+
+' noop to release-inflater
+headers
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/inflater.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/initpgm.fth
===================================================================
--- cpu/arm/initpgm.fth (rev 0)
+++ cpu/arm/initpgm.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,43 @@
+purpose: Generic tools for load image handlers
+\ See license at end of file
+
+: (init-program) ( pc sp -- )
+ clear-save-area state-valid on
+ \ PowerPC calling conventions store the link register at SP+8,
+ \ so we start with r1 a little below the top of the allocated region
+ to sp to pc
+ cif-handler to r0
+
+ h# 53 to psr \ IRQ enabled, FIQ disabled, SVC_32 mode
+
+ restartable? on
+ true to already-go?
+;
+
+: +base ( n -- adr ) load-base + ;
+
+headers
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1995 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/initpgm.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/kerncode.fth
===================================================================
--- cpu/arm/kerncode.fth (rev 0)
+++ cpu/arm/kerncode.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,1224 @@
+purpose: Kernel Primitives for ARM-Risc Processors ARM2 ARM250 ARM3 ARM4
+\ See license at end of file
+
+\ Allocate and clear the initial user area image
+mlabel init-user-area setup-user-area
+
+\ We create the shared code for the "next" routine so that:
+\ a) It will be in RAM for speed (ROM is often slow)
+\ b) We can use the user pointer as its base address, for quick jumping
+
+also forth
+compilation-base here-t \ Save meta dictionary pointer
+\ Use the first version if the user area is separate from the dictionary
+\ 0 dp-t ! userarea-t is compilation-base \ Point it to user area
+userarea-t dp-t ! \ Point it to user area
+previous
+
+code-field: (next) \ Shared code for next; will be copied into user area
+\ also meta assembler
+ ldr pc,[ip],/token
+end-code
+\ previous
+
+also forth
+dp-t ! is compilation-base previous \ Restore meta dict. pointer
+
+d# 32 equ #user-init \ Leaves space for the shared "next"
+
+hex meta assembler definitions
+\ New: the following 3 definitions aren't in this file
+
+\ The first version is for in-line NEXT
+\ :-h next ldr pc,[ip],/token ;-h
+:-h next " mov pc,up" evaluate ;-h
+:-h c; next end-code ;-h
+caps on
+\ also register-names definitions
+\ :-h base r7 ;-h
+\ previous
+
+\ Run-time actions for defining words:
+\ In the Acorn-ARM2/250/3 implementation all words but code definitions are
+\ called by a branch+link instruction. It branches to a relative-inline-
+\ address and leaves the old pc/pcr in the link register r14.
+\ The pfa of the word is just after the branch+link instruction.
+\ bic r0,link,#0xfc000003 or using the lnk macro
+\ lnk r0
+\ Both instructions read the pfa to r0
+
+meta definitions
+code-field: douser
+ psh tos,sp
+ lnk r0
+ ldr r0,[r0]
+ add tos,r0,up
+c;
+code-field: dodoes
+ psh ip,rp
+ lnk ip
+c;
+code-field: dovalue
+ psh tos,sp
+ lnk r0
+ ldr r0,[r0]
+ ldr tos,[up,r0]
+c;
+code-field: docolon
+ psh ip,rp
+ lnk ip
+c;
+code-field: doconstant
+ psh tos,sp
+ lnk r0
+ ldr tos,[r0]
+c;
+code-field: dodefer
+ lnk r0
+ ldr r0,[r0]
+ ldr pc,[r0,up]
+end-code
+code-field: do2constant
+ lnk r0
+
+ ldmia r0,{r1,r2}
+ stmdb sp!,{r1,tos}
+ mov tos,r2
+c;
+code-field: docreate
+ psh tos,sp
+ lnk tos
+c;
+
+code-field: dovariable
+ psh tos,sp
+ lnk tos
+c;
+
+\ New: dopointer (identical to doconstant)
+\ New: dobuffer (identical to doconstant)
+
+:-h compvoc compile-t <vocabulary> ;-h
+code-field: dovocabulary
+ ldr pc,[pc,#-4]
+end-code
+compvoc \ cfa of vocabulary is compiled here
+
+\ New: :-h syscall:
+
+\ Meta compiler words to compile code fields for child words
+:-h place-cf-t \ ( adr -- ) compile a branch+link to adr
+ here-t - 2/ 2/ 2- 00ffffff and eb000000 or l,-t
+;-h
+
+\ psh tos,sp bic tos,lk,#0xfc00.0003
+\ :-h push-pfa ( -- ) e52da004 , e3cea3ff , ;-h
+\ psh tos,sp mov tos,lk
+:-h push-pfa ( -- ) e52da004 , e1a0a00e , ;-h
+:-h code-cf ( -- ) ;-h
+:-h startdoes ( -- ) push-pfa
+ dodoes place-cf-t ;-h
+:-h start;code ( -- ) ;-h \ ???
+:-h colon-cf ( -- ) docolon place-cf-t ;-h
+:-h constant-cf ( -- ) doconstant place-cf-t ;-h
+\ New: :-h buffer-cf ( -- ) dobuffer place-cf-t ;-h
+\ New: :-h pointer-cf ( -- ) dopointer place-cf-t ;-h
+:-h create-cf ( -- ) docreate place-cf-t ;-h
+:-h variable-cf ( -- ) dovariable place-cf-t ;-h
+:-h user-cf ( -- ) douser place-cf-t ;-h
+:-h value-cf ( -- ) dovalue place-cf-t ;-h
+:-h defer-cf ( -- ) dodefer place-cf-t ;-h
+:-h 2constant-cf ( -- ) do2constant place-cf-t ;-h
+:-h vocabulary-cf ( -- ) dovocabulary place-cf-t ;-h
+
+meta definitions
+
+code (lit) ( -- lit )
+ psh tos,sp
+ ldr tos,[ip],1cell
+c;
+code (dlit) ( -- d )
+ ldmia ip!,{r0,r1}
+ stmdb sp!,{r1,tos}
+ mov tos,r0
+c;
+code execute ( cfa -- )
+ mov r0,tos
+ pop tos,sp
+ mov pc,r0
+end-code
+code ?execute ( cfa|0 -- )
+ movs r0,tos
+ pop tos,sp
+ movne pc,r0
+c;
+code @execute ( adr -- )
+ ldr r0,[tos]
+ pop tos,sp
+ mov pc,r0
+end-code
+
+\ Run-time actions for compiling words
+
+code branch ( -- )
+\rel ldr r0,[ip]
+\rel add ip,ip,r0
+\abs ldr ip,[ip]
+c;
+
+code ?branch ( flag -- )
+ cmp tos,#0
+ pop tos,sp
+ addne ip,ip,1cell
+\rel ldreq r0,[ip]
+\rel addeq ip,ip,r0
+\abs ldreq ip,[ip]
+c;
+
+code ?0=branch ( flag -- )
+ cmp tos,#0
+ pop tos,sp
+ inceq ip,1cell
+\rel ldrne r0,[ip]
+\rel addne ip,ip,r0
+\abs ldrne ip,[ip]
+c;
+
+
+code (loop) ( -- )
+ ldr r0,[rp]
+ incs r0,1
+ strvc r0,[rp]
+\rel ldrvc r0,[ip]
+\rel addvc ip,ip,r0
+\abs ldrvc ip,[ip]
+ ldrvc pc,[ip],1cell
+ inc rp,3cells
+ inc ip,1cell
+c;
+
+code (+loop) ( n -- )
+ ldr r0,[rp]
+ adds r0,r0,tos
+ strvc r0,[rp]
+ pop tos,sp
+\rel ldrvc r0,[ip]
+\rel addvc ip,ip,r0
+\abs ldrvc ip,[ip]
+ ldrvc pc,[ip],1cell
+ inc rp,3cells
+ inc ip,1cell
+c;
+
+code (do) ( l i -- )
+ mov r0,tos
+ ldmia sp!,{r1,tos} ( r: loop-end-offset l+0x8000 i-l-0x8000 )
+ psh ip,rp \ save the do offset address
+ inc ip,1cell
+ inc r1,#0x80000000
+ sub r0,r0,r1
+ stmdb rp!,{r0,r1}
+c;
+
+code (?do) ( l i -- )
+ mov r0,tos
+ ldmia sp!,{r1,tos}
+ cmp r1,r0
+\rel ldreq r0,[ip]
+\rel addeq ip,ip,r0
+\abs ldreq ip,[ip]
+ ldreq pc,[ip],1cell
+ ( r: loop-end-offset l+0x8000 i-l-0x8000 )
+ psh ip,rp \ save the do offset address
+ inc ip,1cell
+ inc r1,#0x80000000
+ sub r0,r0,r1
+ stmdb rp!,{r0,r1}
+c;
+
+code i ( -- n )
+ psh tos,sp
+ ldmia rp,{r0,r1}
+ add tos,r1,r0
+c;
+code ilimit ( -- n )
+ psh tos,sp
+ ldr tos,[rp],1cell
+ inc tos,#0x80000000
+c;
+code j ( -- n )
+ psh tos,sp
+ add r2,rp,3cells
+ ldmia r2,{r0,r1}
+ add tos,r1,r0
+c;
+code jlimit ( -- n )
+ psh tos,sp
+ ldr tos,[rp],4cells
+ inc tos,#0x80000000
+c;
+
+code (leave) ( -- )
+ inc rp,2cells \ get rid of the loop indices
+ ldr ip,[rp],1cell
+\rel ldr r0,[ip] \ branch
+\rel add ip,ip,r0
+\abs ldr ip,[ip]
+c;
+
+code (?leave) ( f -- )
+ cmp tos,#0
+ pop tos,sp
+ ldreq pc,[ip],1cell
+ inc rp,2cells \ get rid of the loop indices
+ ldr ip,[rp],1cell
+\rel ldr r0,[ip] \ branch
+\rel add ip,ip,r0
+\abs ldr ip,[ip]
+c;
+
+code unloop ( -- ) inc rp,3cells c; \ Discard the loop indices
+
+\ Run time code for the case statement
+code (of) ( selector test -- [ selector ] )
+ mov r0,tos
+ pop tos,sp
+ cmp tos,r0
+\rel ldrne r0,[ip]
+\rel addne ip,ip,r0
+\abs ldrne ip,[ip]
+ nxtne
+ pop tos,sp
+ inc ip,1cell
+c;
+
+\ (endof) is the same as branch, and (endcase) is the same as drop,
+\ but redefining them this way makes the decompiler much easier.
+code (endof) ( -- )
+\rel ldr r0,[ip]
+\rel add ip,ip,r0
+\abs ldr ip,[ip]
+c;
+
+code (endcase) ( n -- ) pop tos,sp c;
+
+code digit ( char base -- digit true | char false )
+ mov r0,tos \ r0 base
+ ldr r1,[sp] \ r1 char
+ and r1,r1,#0xff
+ cmp r1,#0x41 \ ascii A
+ >= if
+ cmp r1,#0x5b \ ascii [
+ inclt r1,#0x20
+ then
+ mov tos,#0 \ tos false
+ decs r1,#0x30
+ nxtlt
+ cmp r1,#10
+ >= if
+ cmp r1,#0x31
+ nxtlt
+ dec r1,#0x27
+ then
+ cmp r1,r0
+ nxtge
+ str r1,[sp]
+ mvn tos,#0 \ tos true
+c;
+
+code cmove ( from to cnt -- )
+ movs r0,tos \ r0 cnt
+ ldmia sp!,{r1,r2,tos}
+ nxteq
+[ifndef] fixme
+ cmp r1,r2
+ nxteq
+[then]
+ begin
+ ldrb r3,[r2],#1
+ strb r3,[r1],#1
+ decs r0,1
+ 0= until
+c;
+code cmove> ( from to cnt -- )
+ movs r0,tos \ r0 cnt
+ ldmia sp!,{r1,r2,tos}
+ nxteq
+[ifndef] fixme
+ cmp r1,r2
+ nxteq
+[then]
+ begin
+ decs r0,1
+ ldrb r3,[r2,r0]
+ strb r3,[r1,r0]
+ 0= until
+c;
+[ifdef] use-slow-move
+: move ( src dst len -- )
+ >r 2dup u> if r> cmove else r> cmove> then
+;
+[else]
+code move ( src dst cnt -- )
+ movs r0,tos
+ ldmia sp!,{r1,r2,tos}
+ nxteq
+ cmp r1,r2
+ nxteq
+ \ r0:cnt r1:dst r2:src
+ < if \ copy bytes until: src is aligned or cnt=0
+ cmp r0,#4
+ >= if
+ begin
+ ands r3,r2,#3
+ ldrneb r3,[r2],#1
+ strneb r3,[r1],#1
+ decne r0,1
+ 0= until \ copy until source is word-aligned
+ ands r3,r1,#3
+ 0= if \ longword optimizing is possible now
+
+ begin
+ decs r0,4cells
+ ldmgeia r2!,{r3,r4,r5,r6}
+ stmgeia r1!,{r3,r4,r5,r6}
+ < until
+ inc r0,4cells
+
+ begin
+ decs r0,1cell
+ ldrge r3,[r2],1cell
+ strge r3,[r1],1cell
+ < until
+ inc r0,1cell
+ then
+ then
+ begin
+ decs r0,1
+ ldrgeb r3,[r2],#1
+ strgeb r3,[r1],#1
+ 0<= until
+ else
+ add r1,r1,r0
+ add r2,r2,r0
+ cmp r0,#4
+ >= if
+ begin
+ ands r3,r2,#3
+ ldrneb r3,[r2,#-1]!
+ strneb r3,[r1,#-1]!
+ decne r0,1
+ 0= until \ copy until source is word-aligned
+ ands r3,r1,#3
+ 0= if \ longword optimizing is possible now
+
+ begin
+ decs r0,4cells
+ ldmgedb r2!,{r3,r4,r5,r6}
+ stmgedb r1!,{r3,r4,r5,r6}
+ < until
+ inc r0,4cells
+
+ begin
+ decs r0,1cell
+ ldrge r3,[r2,~1cell]!
+ strge r3,[r1,~1cell]!
+ < until
+ inc r0,1cell
+
+ then
+ then
+ begin
+ decs r0,1
+ ldrgeb r3,[r2,#-1]!
+ strgeb r3,[r1,#-1]!
+ <= until
+ then
+c;
+[then]
+
+code noop ( -- ) c;
+
+code and ( n1 n2 -- n3 ) pop r0,sp and tos,tos,r0 c;
+code or ( n1 n2 -- n3 ) pop r0,sp orr tos,tos,r0 c;
+code xor ( n1 n2 -- n3 ) pop r0,sp eor tos,tos,r0 c;
+[ifdef] fixme
+code not ( n1 -- n2 ) mvn tos,tos c;
+code invert ( n1 -- n2 ) mvn tos,tos c;
+
+code lshift ( n1 cnt -- n2 ) pop r0,sp mov tos,r0,lsl tos c;
+code rshift ( n1 cnt -- n2 ) pop r0,sp mov tos,r0,lsr tos c;
+code << ( n1 cnt -- n2 ) pop r0,sp mov tos,r0,lsl tos c;
+code >> ( n1 cnt -- n2 ) pop r0,sp mov tos,r0,lsr tos c;
+code >>a ( n1 cnt -- n2 ) pop r0,sp mov tos,r0,asr tos c;
+code + ( n1 n2 -- n3 ) pop r0,sp add tos,tos,r0 c;
+code - ( n1 n2 -- n3 ) pop r0,sp rsb tos,tos,r0 c;
+[else]
+code + ( n1 n2 -- n3 ) pop r0,sp add tos,tos,r0 c;
+code - ( n1 n2 -- n3 ) pop r0,sp rsb tos,tos,r0 c;
+code not ( n1 -- n2 ) mvn tos,tos c;
+code invert ( n1 -- n2 ) mvn tos,tos c;
+
+code lshift ( n1 cnt -- n2 ) pop r0,sp mov tos,r0,lsl tos c;
+code rshift ( n1 cnt -- n2 ) pop r0,sp mov tos,r0,lsr tos c;
+code << ( n1 cnt -- n2 ) pop r0,sp mov tos,r0,lsl tos c;
+code >> ( n1 cnt -- n2 ) pop r0,sp mov tos,r0,lsr tos c;
+code >>a ( n1 cnt -- n2 ) pop r0,sp mov tos,r0,asr tos c;
+[then]
+
+code negate ( n -- -n ) rsb tos,tos,#0 c;
+
+code ?negate ( n f -- n | -n ) cmp tos,#0 pop tos,sp rsblt tos,tos,#0 c;
+
+code abs ( n -- [n] ) cmp tos,#0 rsbmi tos,tos,#0 c;
+
+code min ( n1 n2 -- n1|n2 ) pop r0,sp cmp tos,r0 movgt tos,r0 c;
+code umin ( u1 u2 -- u1|u2 ) pop r0,sp cmp tos,r0 movcs tos,r0 c;
+code max ( n1 n2 -- n1|n2 ) pop r0,sp cmp r0,tos movgt tos,r0 c;
+code umax ( u1 u2 -- u1|u2 ) pop r0,sp cmp r0,tos movcs tos,r0 c;
+
+code up@ ( -- adr ) psh tos,sp mov tos,up c;
+code sp@ ( -- adr ) psh tos,sp mov tos,sp c;
+code rp@ ( -- adr ) psh tos,sp mov tos,rp c;
+code up! ( adr -- ) mov up,tos pop tos,sp c;
+code sp! ( adr -- ) mov sp,tos pop tos,sp c;
+code rp! ( adr -- ) mov rp,tos pop tos,sp c;
+
+code >r ( n -- ) psh tos,rp pop tos,sp c;
+code r> ( -- n ) psh tos,sp pop tos,rp c;
+code r@ ( -- n ) psh tos,sp ldr tos,[rp] c;
+
+code 2>r ( n1 n2 -- ) mov r0,tos ldmia sp!,{r1,tos} stmdb rp!,{r0,r1} c;
+code 2r> ( -- n1 n2 ) ldmia rp!,{r0,r1} stmdb sp!,{r1,tos} mov tos,r0 c;
+code 2r@ ( -- n1 n2 ) ldmia rp,{r0,r1} stmdb sp!,{r1,tos} mov tos,r0 c;
+
+code >ip ( n -- ) psh tos,rp pop tos,sp c;
+code ip> ( -- n ) psh tos,sp pop tos,rp c;
+code ip@ ( -- n ) psh tos,sp ldr tos,[rp] c;
+
+: ip>token ( ip -- token-adr ) /token - ;
+
+code exit ( -- ) ldr ip,[rp],1cell c;
+code unnest ( -- ) ldr ip,[rp],1cell c;
+
+code ?exit ( flag -- ) cmp tos,#0 pop tos,sp ldrne ip,[rp],1cell c;
+
+code tuck ( n1 n2 -- n2 n1 n2 ) pop r0,sp stmdb sp!,{r0,tos} c;
+
+code nip ( n1 n2 -- n2 ) inc sp,1cell c;
+
+[ifdef] notdef
+code lwsplit ( n -- wlow whigh )
+\ mov r0,#0xffff
+ mov r0,#0xff
+ orr r0,r0,#0xff00
+ and r1,tos,r0
+ psh r1,sp
+ mov tos,tos,lsr #0x10
+c;
+code wljoin ( w.low w.high -- n )
+ pop r0,sp
+ orr tos,r0,tos,lsl #0x10
+c;
+[then]
+code wflip ( n1 -- n2 ) mov tos,tos,ror #0x10 c;
+code flip ( w1 -- w2 )
+ mov r0,tos,lsr #8
+ and r1,tos,#0xff
+ orr tos,r0,r1,lsl #8
+c;
+
+code 0= ( n -- f ) subs tos,tos,#1 sbc tos,tos,tos c;
+code 0<> ( n -- f ) cmp tos,#0 mvnne tos,#0 c;
+code 0< ( n -- f ) mov tos,tos,asr #0 c;
+code 0>= ( n -- f ) mvn tos,tos,asr #0 c;
+code 0> ( n -- f ) bics tos,tos,tos,asr #0 mvnne tos,#0 c;
+code 0<= ( n -- f ) cmp tos,#0 mvnle tos,#0 movgt tos,#0 c;
+
+code > ( n1 n2 -- f ) pop r0,sp cmp r0,tos mvngt tos,#0 movle tos,#0 c;
+code < ( n1 n2 -- f ) pop r0,sp cmp r0,tos mvnlt tos,#0 movge tos,#0 c;
+code = ( n1 n2 -- f ) pop r0,sp cmp r0,tos mvneq tos,#0 movne tos,#0 c;
+[ifdef] fixme
+code <> ( n1 n2 -- f ) pop r0,sp subs tos,r0,tos mvnne tos,#0 c;
+code u> ( u1 u2 -- f ) pop r0,sp subs tos,tos,r0 sbc tos,tos,tos c;
+code u<= ( u1 u2 -- f ) pop r0,sp cmp r0,tos mvnls tos,#0 movhi tos,#0 c;
+code u< ( u1 u2 -- f ) pop r0,sp subs tos,r0,tos sbc tos,tos,tos c;
+code u>= ( u1 u2 -- f ) pop r0,sp cmp r0,tos mvncs tos,#0 movcc tos,#0 c;
+code >= ( n1 n2 -- f ) pop r0,sp cmp r0,tos mvnge tos,#0 movlt tos,#0 c;
+code <= ( n1 n2 -- f ) pop r0,sp cmp r0,tos mvnle tos,#0 movgt tos,#0 c;
+[else]
+code u<= ( u1 u2 -- f ) pop r0,sp cmp r0,tos mvnls tos,#0 movhi tos,#0 c;
+code u>= ( u1 u2 -- f ) pop r0,sp cmp r0,tos mvncs tos,#0 movcc tos,#0 c;
+code >= ( n1 n2 -- f ) pop r0,sp cmp r0,tos mvnge tos,#0 movlt tos,#0 c;
+code <= ( n1 n2 -- f ) pop r0,sp cmp r0,tos mvnle tos,#0 movgt tos,#0 c;
+code <> ( n1 n2 -- f ) pop r0,sp subs tos,r0,tos mvnne tos,#0 c;
+code u> ( u1 u2 -- f ) pop r0,sp subs tos,tos,r0 sbc tos,tos,tos c;
+code u< ( u1 u2 -- f ) pop r0,sp subs tos,r0,tos sbc tos,tos,tos c;
+[then]
+
+code drop ( n1 n2 -- n1 ) pop tos,sp c;
+code dup ( n1 -- n1 n1 ) psh tos,sp c;
+\ code ?dup ( n1 -- 0 | n1 n1 ) cmp tos,#0 pshne tos,sp c;
+code over ( n1 n2 -- n1 n2 n1 ) psh tos,sp ldr tos,[sp,1cell] c;
+code swap ( n1 n2 -- n2 n1 ) ldr r0,[sp] str tos,[sp] mov tos,r0 c;
+code rot ( n1 n2 n3 -- n2 n3 n1 )
+ mov r0,tos
+ ldmia sp!,{r1,tos}
+ stmdb sp!,{r0,r1}
+c;
+code -rot ( n1 n2 n3 -- n3 n1 n2 )
+ ldmia sp!,{r1,r2}
+ stmdb sp!,{r2,tos}
+ mov tos,r1
+c;
+code 2drop ( n1 n2 -- ) inc sp,1cell pop tos,sp c;
+code 3drop ( n1 n2 n3 -- ) inc sp,2cells pop tos,sp c;
+code 4drop ( n1 n2 n3 n4 -- ) inc sp,3cells pop tos,sp c;
+code 5drop ( n1 n2 n3 n4 n5 -- ) inc sp,4cells pop tos,sp c;
+code 2dup ( n1 n2 -- n1 n2 n1 n2 ) ldr r0,[sp] stmdb sp!,{r0,tos} c;
+code 2over ( n1 n2 n3 n4 -- n1 n2 n3 n4 n1 n2 )
+ ldr r0,[sp,2cells]
+ stmdb sp!,{r0,tos}
+ ldr tos,[sp,3cells]
+c;
+code 2swap ( n1 n2 n3 n4 -- n3 n4 n1 n2 )
+ mov r0,tos
+ ldmia sp!,{r1,r2,r3}
+ stmdb sp!,{r0,r1}
+ psh r3,sp
+ mov tos,r2
+c;
+code 3dup ( n1 n2 n3 -- n1 n2 n3 n1 n2 n3 )
+ ldmia sp,{r0,r1}
+ stmdb sp!,{r0,r1,tos}
+c;
+code pick ( nm ... n1 n0 k -- nm ... n1 n0 nk ) ldr tos,[sp,tos,lsl #2] c;
+
+\ code roll ( n -- )
+\ add r1,sp,tos,lsl #2
+\ ldr tos,r1,1cell da
+\ begin
+\ ldria r0,r1,1cell
+\ str r0,[r1],-2cells
+\ cmp r1,sp
+\ < until
+\ inc sp,1cell
+\ c;
+
+\ code between ( n min max -- flag )
+\ mov r1,tos
+\ ldmia sp!,{r0,r2}
+\ mov tos,#0
+\ cmp r2,r0
+\ ldrlt pc,[ip],1cell
+\ cmp r2,r1
+\ mvnle tos,#0
+\ c;
+
+code 1+ ( n -- n+1 ) inc tos,1 c;
+code 2+ ( n -- n+2 ) inc tos,2 c;
+code 1- ( n -- n-1 ) dec tos,1 c;
+code 2- ( n -- n-2 ) dec tos,2 c;
+code 2/ ( n -- n/2 ) mov tos,tos,asr #1 c;
+code u2/ ( u -- u/2 ) mov tos,tos,lsr #1 c;
+code 2* ( n -- 2n ) mov tos,tos,lsl #1 c;
+code 4* ( n -- 4n ) mov tos,tos,lsl #2 c;
+code 8* ( n -- 8n ) mov tos,tos,lsl #3 c;
+
+code on ( adr -- ) mvn r0,#0 str r0,[tos] pop tos,sp c;
+code off ( adr -- ) mov r0,#0 str r0,[tos] pop tos,sp c;
+code +! ( n adr -- )
+ mov r0,tos
+ ldmia sp!,{r1,tos}
+ ldr r2,[r0]
+ add r2,r2,r1
+ str r2,[r0]
+c;
+
+code l@ ( adr -- n ) ldr tos,[tos] c;
+[ifdef] arm4
+\ Halfword access
+code w! ( w adr -- )
+ pop r0,sp
+ h# e1ca00b0 asm, \ strh r0,tos
+ pop tos,sp
+c;
+code w@ ( adr -- w )
+ h# e1daa0b0 asm, \ ldrh tos,tos
+c;
+code <w@ ( adr -- w )
+ h# e1daa0f0 asm, \ ldrsh tos,tos
+c;
+
+\ code w@ ( adr -- n ) ldrh tos,[tos] c;
+\ code <w@ ( adr -- n ) ldrsh tos,[tos] c;
+\ code w! ( n adr -- )
+\ pop r0,sp
+\ strh r0,[tos]
+\ pop tos,sp
+\ c;
+[else]
+code w@ ( adr -- n ) ldr tos,[tos] c;
+code <w@ ( adr -- n ) ldr tos,[tos] c;
+code w! ( n adr -- ) pop r0,sp str r0,[tos] pop tos,sp c;
+[then]
+code l! ( n adr -- ) pop r0,sp str r0,[tos] pop tos,sp c;
+code @ ( adr -- n ) ldr tos,[tos] c;
+
+code unaligned-@ ( adr -- n )
+ bic r1,tos,#3
+ ldmia r1,{r2,r3}
+ and r1,tos,#3
+ movs r1,r1,lsl #3
+ movne r2,r2,lsr r1
+ rsbne r1,r1,#0x20
+ orrne r2,r2,r3,lsl r1
+ mov tos,r2
+c;
+code c@ ( adr -- char ) ldrb tos,[tos] c;
+code ! ( n adr -- ) pop r0,sp str r0,[tos] pop tos,sp c;
+code unaligned-! ( n adr -- )
+ mov r5,tos \ r5: adr
+ ldmia sp!,{r4,tos}
+ strb r4,[r5],#1
+ mov r4,r4,ror #8
+ strb r4,[r5],#1
+ mov r4,r4,ror #8
+ strb r4,[r5],#1
+ mov r4,r4,ror #8
+ strb r4,[r5],#1
+c;
+
+code unaligned-w@ ( adr -- w )
+ ldrb r0,[tos]
+ ldrb tos,[tos,#1]
+
+ orr tos,r0,tos,lsl #8
+c;
+code unaligned-w! ( w adr -- )
+ pop r0,sp
+ strb r0,[tos]
+ mov r0,r0,ror #8
+ strb r0,[tos,#1]
+
+ pop tos,sp
+c;
+: unaligned-l@ ( adr -- l ) unaligned-@ ;
+: unaligned-l! ( l adr -- ) unaligned-! ;
+: unaligned-d! ( d adr -- ) tuck na1+ unaligned-! unaligned-! ;
+: d@ ( adr -- d ) dup @ swap na1+ @ ;
+
+code c! ( char adr -- ) pop r0,sp strb r0,[tos] pop tos,sp c;
+code 2@ ( adr -- n-high n-low )
+ ldr r0,[tos,1cell]
+ psh r0,sp
+ ldr tos,[tos]
+c;
+code 2! ( n-high n-low adr -- )
+ ldmia sp!,{r0,r1}
+ stmia tos,{r0,r1}
+ pop tos,sp
+c;
+
+code d+ ( d1 d2 -- d1+d2 )
+ ldmia sp!,{r0,r1,r2} \ tos r0 r1 r2
+ adds r0,r0,r2
+ adc tos,tos,r1
+ psh r0,sp
+c;
+
+code d- ( d1 d2 -- d1-d2 )
+ ldmia sp!,{r0,r1,r2} \ tos r0 r1 r2
+ subs r2,r2,r0
+ sbc r1,r1,tos
+ psh r2,sp
+ mov tos,r1
+c;
+code d< ( d1 d2 -- f )
+ ldmia sp!,{r0,r1,r2} \ tos r0 r1 r2
+ subs r2,r2,r0
+ sbcs tos,r1,tos
+ mov tos,tos,asr #0
+c;
+code d> ( d1 d2 -- f )
+ ldmia sp!,{r0,r1,r2} \ tos r0 r1 r2
+ subs r0,r0,r2
+ sbcs tos,tos,r1
+ mov tos,tos,asr #0
+c;
+code du< ( d1 d2 -- f )
+ ldmia sp!,{r0,r1,r2} \ tos r0 r1 r2
+ subs r2,r2,r0
+ sbcs r1,r1,tos
+ sbc tos,tos,tos
+c;
+
+code s>d ( n -- d )
+ psh tos,sp
+ mov tos,tos,asr #0
+c;
+code dnegate ( d -- -d )
+ pop r0,sp
+ rsbs r0,r0,#0
+ rsc tos,tos,#0
+ psh r0,sp
+c;
+code ?dnegate ( d flag -- d )
+ cmp tos,#0
+ pop tos,sp
+ < if
+ pop r0,sp
+ rsbs r0,r0,#0
+ rsc tos,tos,#0
+ psh r0,sp
+ then
+c;
+
+code dabs ( d -- d )
+ cmp tos,#0
+ < if
+ pop r0,sp
+ rsbs r0,r0,#0
+ rsc tos,tos,#0
+ psh r0,sp
+ then
+c;
+code d0= ( d -- f )
+ pop r0,sp
+ orrs r0,r0,tos
+ mvneq tos,#0
+ movne tos,#0
+c;
+code d0< ( d -- f )
+ inc sp,1cell
+ mov tos,tos,asr #0
+c;
+code d2* ( d1 -- d2 )
+ pop r0,sp
+ mov tos,tos,lsl #1
+ orr tos,tos,r0,lsr #31
+ mov r0,r0,lsl #1
+ psh r0,sp
+c;
+code d2/ ( s1 -- d2 )
+ pop r0,sp
+ movs tos,tos,lsr #1
+ mov r0,r0,ror #0
+ psh r0,sp
+c;
+: d= ( d1 d2 -- flag ) d- d0= ;
+: d<> ( d1 d2 -- flag ) d= 0= ;
+
+: (d.) ( d -- adr len ) tuck dabs <# #s rot sign #> ;
+: (ud.) ( ud -- adr len ) <# #s rot #> ;
+
+: d. ( d -- ) (d.) type space ;
+: ud. ( ud -- ) (ud.) type space ;
+: ud.r ( ud n -- ) >r (ud.) r> over - spaces type ;
+
+: dmax ( xd1 xd2 -- ) 2over 2over d< if 2swap then 2drop ;
+: dmin ( xd1 xd2 -- ) 2over 2over d< 0= if 2swap then 2drop ;
+
+code fill ( adr cnt char -- )
+ orr r2,tos,tos,lsl #8
+ ldmia sp!,{r0,r1,tos} \ r0-cnt r1-adr r2-data
+ cmp r0,#4
+ > if
+ orr r2,r2,r2,lsl #0x10 \ Propagate character into high halfword
+ begin \ Fill initial unaligned part
+ ands r3,r1,#3
+ decne r0,1
+ strneb r2,[r1],#1
+ 0= until
+ decs r0,4
+ begin
+ strge r2,[r1],#4
+ decges r0,4
+ < until
+ inc r0,4
+ then
+ begin
+ decs r0,1
+ strgeb r2,[r1],#1
+ < until
+c;
+
+code wfill ( adr cnt w -- )
+ mov r2,tos
+ ldmia sp!,{r0,r1,tos} \ r0-cnt r1-adr r2-data
+ begin
+ decs r0,2
+ strgeh r2,[r1],#2
+ < until
+c;
+
+code lfill ( adr cnt l -- )
+ mov r2,tos
+ ldmia sp!,{r0,r1,tos} \ r0-cnt r1-adr r2-data
+ begin
+ decs r0,4
+ strge r2,[r1],#4
+ < until
+c;
+
+\ code /link ( -- /link ) psh tos,sp mov tos,/link c;
+
+code /char ( -- 1 ) psh tos,sp mov tos,#1 c;
+code /cell ( -- 4 ) psh tos,sp mov tos,1cell c;
+
+code chars ( n1 -- n1 ) c;
+code cells ( n -- 4n ) mov tos,tos,lsl #2 c;
+code char+ ( adr -- adr1 ) inc tos,#1 c;
+code cell+ ( adr -- adr1 ) inc tos,1cell c;
+code chars+ ( adr index -- adr1 ) pop r0,sp add tos,r0,tos c;
+code cells+ ( adr index -- adr1 ) pop r0,sp add tos,r0,tos,lsl #2 c;
+
+code next-char ( addr u -- addr-char u+char )
+ dec tos,1
+ pop r0,sp
+ inc r0,1
+ psh r0,sp
+c;
+
+code n->l ( n.unsigned -- l ) c;
+code ca+ ( adr index -- adr1 ) pop r0,sp add tos,r0,tos c;
+code wa+ ( adr index -- adr1 ) pop r0,sp add tos,r0,tos,lsl #1 c;
+code la+ ( adr index -- adr1 ) pop r0,sp add tos,r0,tos,lsl #2 c;
+code na+ ( adr index -- adr1 ) pop r0,sp add tos,r0,tos,lsl #2 c;
+code ta+ ( adr index -- adr1 ) pop r0,sp add tos,r0,tos,lsl #2 c;
+
+code ca1+ ( adr -- adr1 ) inc tos,1 c;
+code wa1+ ( adr -- adr1 ) inc tos,2 c;
+code la1+ ( adr -- adr1 ) inc tos,1cell c;
+code na1+ ( adr -- adr1 ) inc tos,1cell c;
+code ta1+ ( adr -- adr1 ) inc tos,1cell c;
+
+code /c ( -- 1 ) psh tos,sp mov tos,#1 c;
+code /w ( -- 4 ) psh tos,sp mov tos,#2 c;
+code /l ( -- 4 ) psh tos,sp mov tos,#4 c;
+code /n ( -- 4 ) psh tos,sp mov tos,1cell c;
+
+code /c* ( n1 -- n1 ) c;
+code /w* ( n1 -- n2 ) mov tos,tos,lsl #1 c;
+code /l* ( n1 -- n2 ) mov tos,tos,lsl #2 c;
+code /n* ( n1 -- n2 ) mov tos,tos,lsl #2 c;
+
+8 equ nvocs \ Number of slots in the search order
+
+code upc ( char -- upper-case-char )
+ and tos,tos,#0xff
+ cmp tos,#0x61 \ ascii a
+ nxtlt
+ cmp tos,#0x7b \ ascii {
+ declt tos,#0x20
+c;
+code lcc ( char -- lower-case-char )
+ and tos,tos,#0xff
+ cmp tos,#0x41 \ ascii A
+ nxtlt
+ cmp tos,#0x5b \ ascii [
+ inclt tos,#0x20
+c;
+code comp ( adr1 adr2 len -- -1 | 0 | 1 )
+ inc tos,1 \ tos length
+ ldmia sp!,{r0,r1}
+ begin
+ decs tos,#1
+ 0<> while
+ ldrb r2,[r0],#1
+ ldrb r3,[r1],#1
+ cmp r2,r3
+[ifdef] fixme
+0<> if
+ movgt tos,#1
+ mvnlt tos,#0
+ nxtne
+then
+[else]
+ movgt tos,#1
+ mvnlt tos,#0
+ nxtne
+[then]
+ repeat
+ mov tos,#0
+c;
+code caps-comp ( adr1 adr2 len -- -1 | 0 | 1 )
+ add tos,tos,#1 \ tos length
+ ldmia sp!,{r0,r1}
+ begin
+ decs tos,1
+ 0<> while
+ mov r2,#0
+ ldrb r2,[r0],#1
+ cmp r2,#0x41 \ ascii A
+ > if
+ cmp r2,#0x5b \ ascii [
+ inclt r2,#0x20
+ then
+ mov r3,#0
+ ldrb r3,[r1],#1
+ cmp r3,#0x41 \ ascii A
+ > if
+ cmp r3,#0x5b \ ascii [
+ inclt r3,#0x20
+ then
+ cmp r2,r3
+[ifdef] fixme
+0<> if
+ movgt tos,#1
+ mvnlt tos,#0
+ nxtne
+then
+[else]
+ movgt tos,#1
+ mvnlt tos,#0
+ nxtne
+[then]
+ repeat
+ mov tos,#0
+c;
+code pack ( str-adr len to -- to )
+ mov r0,tos \ to
+ ldmia sp!,{r1,r2}
+ ands r1,r1,#0xff \ set length flag
+ strb r1,[r0],#1
+ 0<> if
+ begin
+ ldrb r3,[r2],#1
+ strb r3,[r0],#1
+ decs r1,#1
+ 0= until
+ then
+ mov r1,#0
+ strb r1,[r0],#1
+c;
+
+code (') ( -- n ) psh tos,sp ldr tos,[ip],1cell c;
+
+\ Modifies caller's ip to skip over an in-line string
+code skipstr ( -- adr len)
+ psh tos,sp
+ ldr r0,[rp]
+ ldrb tos,[r0],#1
+ psh r0,sp
+ add r0,r0,tos
+ inc r0,1cell
+ bic r0,r0,#3
+ str r0,[rp]
+c;
+code (") ( -- adr len)
+ psh tos,sp
+ ldrb tos,[ip],#1
+ psh ip,sp
+ add ip,ip,tos
+ inc ip,#4
+ bic ip,ip,#3
+c;
+code traverse ( adr direction -- adr' )
+ mov r0,tos \ direction r0
+ pop tos,sp \ adr -> tos
+ add tos,tos,r0
+ begin
+ ldrb r1,[tos]
+ and r1,r1,#0x80
+ 0= while
+ add tos,tos,r0
+ repeat
+c;
+code count ( adr -- adr1 cnt )
+ mov r0,tos
+ ldrb tos,[r0],#1
+ psh r0,sp
+c;
+
+: instruction! ( n adr -- ) tuck l! /cell sync-cache ;
+
+\ a colon-magic doesn't exist in this ARM version
+: place-cf ( adr -- )
+ acf-align
+ here - 2/ 2/ 2- 00ffffff and eb000000 or
+ here /cell allot instruction!
+;
+\ place a branch+link to target at adr
+: put-cf ( target adr -- )
+ dup >r - 2/ 2/ 2- 00ffffff and eb000000 or
+ r> instruction!
+;
+
+: instruction, ( n -- ) here /cell allot instruction! ;
+: push-pfa ( -- adr )
+ e52da004 instruction, \ psh tos,sp
+\ e3cea3ff instruction, \ bic tos,lk,#0xfc00.0003
+ e1a0a00e instruction, \ mov tos,lk
+;
+
+: origin- ( adr -- offset ) origin - ;
+: origin+ ( offset -- adr ) origin + ;
+
+: code-cf ( -- ) acf-align ;
+: code? ( acf -- f ) \ True if the acf is for a code word
+ @ h# ff000000 and h# eb000000 <>
+;
+: >code ( acf-of-code-word -- address-of-start-of-machine-code ) ;
+
+\ Ip is assumed to point to (;code . flag is true if
+\ the code at ip is a does> clause as opposed to a ;code clause.
+
+: colon-cf ( -- ) docolon origin+ place-cf ;
+: colon-cf? ( adr -- flag ) word-type docolon origin + = ;
+: docolon ( -- adr ) docolon origin+ ;
+: create-cf ( -- ) docreate origin+ place-cf ;
+: variable-cf ( -- ) dovariable origin+ place-cf ;
+: user-cf ( -- ) douser origin+ place-cf ;
+: value-cf ( -- ) dovalue origin+ place-cf ;
+: constant-cf ( -- ) doconstant origin+ place-cf ;
+: defer-cf ( -- ) dodefer origin+ place-cf ;
+: 2constant-cf ( -- ) do2constant origin+ place-cf ;
+: place-does ( -- ) push-pfa dodoesaddr token@ place-cf ;
+
+: does-ip? ( ip -- ip' flag )
+ dup token@ ['] (does>) = if 4 na+ true else na1+ false then
+;
+
+: place-;code ( -- ) ;
+
+\ next is redefined in cpu/arm/code.fth so that it can be conditional
+\ Version for next in user area
+: next ( -- ) h# e1a0f009 instruction, ;
+\ Version for in-line next
+\ : next ( -- ) h# e498f004 instruction, ;
+
+\ New: : pointer-cf ( -- ) dopointer literal origin+ place-cf ;
+\ New: : buffer-cf ( -- ) dobuffer literal origin+ place-cf ;
+
+\ uses sets the code field of the indicated word so that
+\ it will execute the code at action-clause-adr
+: uses ( action-clause-adr xt -- ) put-cf ;
+
+\ used sets the code field of the most-recently-defined word so that
+\ it executes the code at action-clause-adr
+: used ( action-clause-adr -- ) lastacf uses ;
+
+\ operators using addresses, links and tokens
+/a-t constant /a
+: a@ ( adr -- adr ) l@ ;
+: a! ( adr adr -- ) set-relocation-bit l! ;
+: a, ( adr -- ) here /a allot a! ;
+\ : link@ ( adr -- adr ) @ ;
+\ : link! ( adr adr -- ) a! ;
+\ : link, ( adr -- ) a, ;
+\ : link-here ( adr -- ) align here over @ link, swap ! ;
+
+/n-t constant /branch
+
+\rel : branch, ( offset -- ) , ;
+\rel : branch! ( offset where -- ) ! ;
+\rel : branch@ ( where -- offset ) @ ;
+\rel : >target ( ip -- target ) ta1+ dup branch@ + ( h# ffffc and ) ;
+\abs : branch, ( offset -- ) here + a, ;
+\abs : branch! ( offset where -- ) swap over + swap a! ;
+\abs : branch@ ( where -- offset ) @ ;
+\abs : >target ( ip -- target ) ta1+ branch@ ;
+
+/token constant /token
+: token@ ( adr -- cfa ) l@ ;
+: token! ( cfa adr -- ) set-relocation-bit l! ;
+: token, ( cfa -- ) here /token allot token! ;
+
+\ XXX this is a kludgy way to make a relocated constant
+origin-t constant origin /n negate allot-t origin-t token,-t
+
+: null ( -- token ) origin ;
+: !null-link ( adr -- ) null swap link! ;
+: !null-token ( adr -- ) null swap token! ;
+: non-null? ( link -- false | link true )
+ dup origin = if drop false else true then
+;
+: get-token? ( adr -- false | acf true ) token@ non-null? ;
+: another-link? ( adr -- false | link true ) link@ non-null? ;
+
+\ The "word type" is a number which distinguishes one type of word
+\ from another. This is highly implementation-dependent.
+\ For the ARM Implementation, this always returns the adress of the
+\ code sequence for that word.
+
+code >body ( cfa -- pfa )
+ ldr r0,[tos]
+ and r0,r0,#0xff000000
+ cmp r0,#0xeb000000
+ inceq tos,1cell
+c;
+code body> ( pfa -- cfa )
+ ldr r0,[tos,~/token]
+ and r0,r0,#0xff000000
+ cmp r0,#0xeb000000
+ deceq tos,1cell
+c;
+code word-type ( cfa -- word-type )
+ ldr r0,[tos]
+ and r1,r0,#0xff000000
+ cmp r1,#0xeb000000
+ moveq r0,r0,lsl #8
+ moveq r0,r0,asr #6
+ inceq r0,8
+ addeq tos,tos,r0
+\ bic tos,tos,#0xfc000003
+c;
+
+4 constant /user#
+
+\ Move to a machine alignment boundary. All ARM-Processors need
+\ 32-bit alignment
+: aligned ( adr -- adr' ) /n round-up ;
+: acf-aligned ( adr -- adr' ) aligned ;
+: acf-align ( adr -- adr' )
+ begin here #acf-align 1- and while 0 c, repeat
+ here 'lastacf token!
+;
+
+only forth also labels also meta
+also arm-assembler helpers also arm-assembler definitions
+:-h 'body ( "name" -- variable-apf adt-immed )
+ [ also meta ]-h ' ( acf-of-user-variable ) >body-t
+ [ previous ]-h adt-immed
+;-h
+:-h 'code ( "name" -- code-word-acf adt-immed )
+ [ also meta ]-h ' ( acf-of-user-variable )
+ [ previous ]-h adt-immed
+;-h
+:-h 'user# ( "name" -- user# adt-immed )
+ [ also meta ]-h ' ( acf-of-user-variable ) >body-t @-t
+ [ previous ]-h adt-immed
+;-h
+:-h 'user ( "name" -- )
+\ [ also register-names ] up [ previous ] drop ( reg# )
+ up drop ( reg# )
+ d# 16 lshift iop
+ 'user# ( value adt-immed )
+ drop d# 12 ?#bits iop
+;
+only forth also labels also meta also definitions
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/kerncode.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/kernel.bth
===================================================================
--- cpu/arm/kernel.bth (rev 0)
+++ cpu/arm/kernel.bth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,151 @@
+purpose: Load file for ARM Forth kernel
+\ See license at end of file
+
+command: &builder &this
+build-now
+
+\ z only forth also definitions decimal
+\ z warning on
+
+\ ' $report-name is include-hook
+ ' noop is include-hook
+\ ' noop is include-exit-hook
+
+\ Don't accept ',' as numeric punctuation because doing so makes
+\ the forward referencing mechanism think that "c," is a number!
+ascii . ascii , npatch numdelim?
+
+warning off \ Turn OFF the warning messages
+
+\ Configure for relative branch targets. Absolute branch targets
+\ do not work correctly with FCode because of the way that FCode
+\ backward branch resolution works.
+: \rel ( -- ) ; immediate
+: \abs ( -- ) [compile] \ ; immediate
+create arm4
+
+alias constant-h constant
+
+fload ${BP}/forth/kernel/conft32.fth
+fload ${BP}/forth/kernel/meta1.fth
+
+
+[ifndef] arm-assembler \ Make sure we have the ARM assembler
+order cr
+only forth also definitions
+
+fload ${BP}/forth/lib/bitops.fth
+\needs set-relocation-bit defer set-relocation-bit \ keep init-assem happy
+
+\ only forth also meta also definitions
+
+fload ${BP}/cpu/arm/assem.fth
+fload ${BP}/cpu/arm/code.fth
+
+[then]
+only forth also meta also definitions
+: sx .s cr ;
+
+only forth also meta definitions
+: assembler ( -- ) arm-assembler ;
+
+only forth also meta also assembler definitions
+\needs L: fload ${BP}/forth/lib/loclabel.fth
+init-labels
+
+only forth also definitions
+\needs bitset fload ${BP}/forth/lib/bitops.fth
+
+fload ${BP}/forth/kernel/nswapmap.fth \ Null swap map
+\ : : : lastacf .name cr ;
+fload ${BP}/cpu/arm/target.fth
+fload ${BP}/forth/kernel/forward.fth
+fload ${BP}/cpu/ppc/fixvoc.fth
+fload ${BP}/forth/kernel/metacompile.fth
+
+fload ${BP}/cpu/arm/metarel.fth
+
+only forth meta also forth also definitions
+
+' meta-set-relocation-bit is set-relocation-bit-t
+' meta-init-relocation is init-relocation-t
+\ protocol? on
+
+only forth also definitions decimal
+
+warning on
+fload ${BP}/cpu/arm/metainit.fth
+
+" kernel.tag" r/w create-file drop meta-tag-file !
+
+always-headers
+
+\ Comment out the following line(s) when debugging
+-1 threshold ! \ Turn OFF ALL debugging messages
+warning-t off \ Turn OFF target warning messages
+
+\ Uncomment the following line(s) for more debug output
+\ show? on 1 granularity ! 1 threshold !
+\ warning-t on
+
+fload ${BP}/cpu/arm/kerncode.fth
+fload ${BP}/cpu/arm/extra.fth
+
+fload ${BP}/forth/kernel/uservars.fth
+fload ${BP}/cpu/arm/muldiv.fth \ Uses "defer"; must be after uservars
+fload ${BP}/cpu/arm/dodoesad.fth
+fload ${BP}/cpu/arm/version.fth
+
+fload ${BP}/forth/kernel/double.fth \ ???
+fload ${BP}/forth/kernel/scan.fth
+
+fload ${BP}/cpu/arm/bitops.fth
+fload ${BP}/cpu/arm/kernrel.fth
+
+fload ${BP}/forth/lib/struct.fth
+
+fload ${BP}/forth/kernel/kernel.fth
+
+fload ${BP}/forth/kernel/sysio.fth
+fload ${BP}/forth/lib/dumballo.fth
+fload ${BP}/cpu/arm/sys.fth
+
+\ fload ${BP}/forth/kernel/nswapmap.fth \ Null swap map
+
+\ fload ${BP}/cpu/arm/field.fth
+fload ${BP}/cpu/arm/filecode.fth
+
+fload ${BP}/cpu/arm/boot.fth
+fload ${BP}/forth/kernel/init.fth
+fload ${BP}/cpu/arm/finish.fth
+
+fload ${BP}/cpu/arm/savemeta.fth
+
+\Tags close-tag-file
+\NotTags .( --- Saving ) " kernel.dic" type .( ---)
+" kernel.dic" $save-meta cr
+cr
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2008 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/kernel.bth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/kernfloat.fth
===================================================================
--- cpu/arm/kernfloat.fth (rev 0)
+++ cpu/arm/kernfloat.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,63 @@
+purpose: Kernel-level floating point words
+\ See license at end of file
+
+\ Contributed by Hanno Schwalm
+
+code fp@ ( -- adr )
+ top sp push
+ top 'user fp ldr c;
+
+code fp! ( a_adr -- )
+ top 'user fp str
+ top sp pop c;
+code (flit) ( -- )
+ r0 r1 2 ip ia! ldm
+ r2 'user fp ldr
+ r0 r1 2 r2 db! stm
+ r2 'user fp str c;
+code f@ ( adr -- ) ( -- f1 )
+ r0 r1 2 top ia ldm
+ r2 'user fp ldr
+ r0 r1 2 r2 db! stm
+ r2 'user fp str
+ top sp pop c;
+code f! ( adr -- ) ( f1 -- )
+ r2 'user fp ldr
+ r0 r1 2 r2 ia! ldm
+ r2 'user fp str
+ r0 r1 2 top ia stm
+ top sp pop c;
+
+code /float ( -- 8)
+ top sp push top 8 # mov c;
+code floats ( n -- 8n )
+ top top 3 #asl mov c;
+code float+ ( adr -- adr1 )
+ top 8 incr c;
+code floats+ ( a_adr index -- a_adr1 )
+ r0 sp pop
+ top r0 top 3 #asl add c;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2008 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/kernfloat.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/kernrel.fth
===================================================================
--- cpu/arm/kernrel.fth (rev 0)
+++ cpu/arm/kernrel.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,81 @@
+purpose: Maintains a bitmap identifying longwords that need to be relocated
+\ See license at end of file
+
+\ h# 8.0000 equ max-image
+h# 8.0000 constant max-image
+
+0 value relocation-map
+
+\ The relocation map has one bit for every 32-bit word, since we assume
+\ that relocated longwords must start on a 32-bit boundary
+
+\ If the address is within the new part of the dictionary (between
+\ relocation-base and relocation-base + max-image), set the corresponding
+\ bit in relocation-map. If the address is within the user area,
+\ (between up@ and up@ + #user), set the corresponding bit in
+\ user-relocation-map
+
+: >relbit ( adr -- bit# array ) origin - /l / relocation-map ;
+
+\ This has to be deferred so it can be turned off until the relocation
+\ table has been initialized.
+
+defer set-relocation-bit ' noop is set-relocation-bit
+defer clear-relocation-bits ' 2drop is clear-relocation-bits
+: (set-relocation-bit ( adr -- adr )
+ dup origin dup max-image + within if ( adr )
+ dup >relbit bitset
+ then
+;
+: (clear-relocation-bits ( adr len -- )
+ bounds ?do i >relbit bitclear /n +loop
+;
+
+: relocation-on ( -- )
+ ['] (set-relocation-bit ['] set-relocation-bit (is
+ ['] (clear-relocation-bits ['] clear-relocation-bits (is
+;
+: relocation-off ( -- )
+ ['] noop ['] set-relocation-bit (is
+ ['] 2drop ['] clear-relocation-bits (is
+;
+
+: init-relocation ( -- ) \ Allocate relocation map
+ max-image d# 32 / ( #map-bytes )
+ dup alloc-mem ( #map-bytes adr )
+ is relocation-map ( #map-bytes )
+ relocation-map swap erase
+ here relocation-map
+ origin h# 10 + l@ h# 1f + 5 rshift move
+
+ \ Now that the table is set up, set-relocation-bit may be turned on
+ relocation-on
+;
+
+: set-swap-bit ( addr -- ) drop ;
+: note-string ( adr len -- adr len ) ;
+decimal
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/kernrel.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/loadmach.fth
===================================================================
--- cpu/arm/loadmach.fth (rev 0)
+++ cpu/arm/loadmach.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,68 @@
+purpose: Load file for machine-dependent Forth tools
+\ See license at end of file
+
+assembler? [if]
+fload ${BP}/cpu/arm/assem.fth
+fload ${BP}/cpu/arm/code.fth
+fload ${BP}/forth/lib/loclabel.fth
+[else]
+transient fload ${BP}/cpu/arm/assem.fth resident
+fload ${BP}/cpu/arm/code.fth
+transient fload ${BP}/forth/lib/loclabel.fth resident
+[then]
+
+fload ${BP}/cpu/arm/decompm.fth
+
+: be-l, ( l -- ) here 4 note-string allot be-l! ;
+
+\needs $save-forth transient fload ${BP}/cpu/arm/savefort.fth resident
+\ alias $save-forth $save-forth
+
+fload ${BP}/cpu/arm/disassem.fth \ Exports (dis , pc , dis1 , +dis
+fload ${BP}/forth/lib/instdis.fth
+
+fload ${BP}/cpu/arm/objsup.fth
+fload ${BP}/forth/lib/objects.fth
+
+fload ${BP}/cpu/arm/call.fth \ C subroutine calls
+
+fload ${BP}/forth/lib/rstrace.fth
+fload ${BP}/cpu/arm/debugm.fth \ Forth debugger support
+fload ${BP}/forth/lib/debug.fth \ Forth debugger
+
+fload ${BP}/cpu/arm/cpustate.fth
+fload ${BP}/cpu/arm/register.fth
+
+fload ${BP}/forth/lib/savedstk.fth
+fload ${BP}/cpu/arm/ftrace.fth
+fload ${BP}/cpu/arm/ctrace.fth
+
+start-module \ Breakpointing
+fload ${BP}/cpu/arm/cpubpsup.fth \ Breakpoint support
+fload ${BP}/forth/lib/breakpt.fth
+\ fload ${BP}/cpu/arm/catchexc.fth
+end-module
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1994 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/loadmach.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/loadvmem.fth
===================================================================
--- cpu/arm/loadvmem.fth (rev 0)
+++ cpu/arm/loadvmem.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,47 @@
+purpose: Load file for virtual memory node
+\ See license at end of file
+
+headers
+fload ${BP}/ofw/core/allocmor.fth \ S Allow alloc-mem to use more memory
+
+dev /
+new-device
+" mmu" device-name
+fload ${BP}/ofw/core/virtlist.fth \ Virtual memory allocator
+fload ${BP}/ofw/core/maplist.fth \ Manage translation list
+
+fload ${BP}/cpu/arm/mmu.fth
+
+: .t translations translation-node .list ;
+
+' 2drop is ?splice
+
+finish-device
+device-end
+
+: map? ( virtual -- ) " map?" mmu-node @ $call-method ;
+: .t ( -- ) " .t" mmu-node @ $call-method ;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/loadvmem.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/memtest.fth
===================================================================
--- cpu/arm/memtest.fth (rev 0)
+++ cpu/arm/memtest.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,112 @@
+purpose: Memory test primitives in assembly language
+\ See license at end of file
+
+headers
+\needs mask nuser mask mask on
+headerless
+
+\ Report the progress through low-level tests
+0 0 2value test-name
+: show-status ( adr len -- ) to test-name ;
+
+code lfill ( adr len l -- )
+ \ tos: pattern
+ ldmia sp!,{r0,r1} \ r0: len, r1: adr
+
+ ahead begin \ Fill
+ str tos,[r0,r1]
+ but then
+ decs r0,1cell
+ 0< until
+
+ pop tos,sp
+c;
+
+code masked-ltest ( adr len l mask -- error? )
+ mov r4,tos \ r4: mask
+ ldmia sp!,{r0,r1,r2} \ r0: l, r1: len, r2: adr
+ and r0,r0,r4 \ Mask l
+ mvn tos,#0 \ tos: failure code (in case of mismatch)
+
+ ahead begin \ Test
+ ldr r3,[r2,r1] \ Get data from memory
+ and r3,r3,r4 \ mask memory data
+ cmp r3,r0 \ Test under mask
+ nxtne \ Exit if mismatch
+ but then
+ decs r1,1cell
+ 0< until
+
+ mov tos,#0
+c;
+
+: mem-bits-test ( membase memsize -- fail-status )
+ " Data bits test" show-status
+ 2dup h# 5a5a5a5a lfill
+ 2dup h# 5a5a5a5a mask @ masked-ltest if 2drop true exit then
+
+ 2dup h# a5a5a5a5 lfill
+ h# a5a5a5a5 mask @ masked-ltest
+;
+
+code afill ( adr len -- )
+ pop r0,sp \ tos: len, r0: adr
+
+ ahead begin \ Fill
+ add r1,r0,tos \ Compute address
+ str r1,[r0,tos] \ Store it at the location
+ but then
+ decs tos,1cell \ Decrement index
+ 0< until
+
+ pop tos,sp
+c;
+
+code masked-atest ( adr len mask -- mismatch? )
+ mov r4,tos \ r4: mask
+ ldmia sp!,{r0,r1} \ r0: len, r1: adr
+ mvn tos,#0 \ tos: failure code (in case of mismatch)
+
+ ahead begin \ Check
+ add r2,r0,r1 \ Compute pattern
+ and r2,r2,r4 \ under mask
+ ldr r3,[r0,r1] \ Get data from memory
+ and r3,r3,r4 \ under mask
+ cmp r3,r2 \ Compare
+ nxtne \ Exit if mismatch
+ but then
+ decs r0,1cell
+ 0< until
+
+ mov tos,#0
+c;
+
+: address=data-test ( membase memsize -- status )
+ " Address=data test" show-status
+
+ 2dup afill mask @ masked-atest
+;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/memtest.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/metainit.fth
===================================================================
--- cpu/arm/metainit.fth (rev 0)
+++ cpu/arm/metainit.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,68 @@
+purpose: Metacompiler initialization for kernel compilation
+\ See license at end of file
+
+\ Handle command line
+\ Make interpreter re-entrant - multiple tibs? (pokearound)
+\ Handle end-of-file on input stream
+\ Fix "" to be state smart
+\ Meta compiler source for the Forth 83 kernel.
+\ Debugging aids
+
+hex
+ 0 #words !
+ 800 threshold !
+ 800 granularity !
+warning off
+
+forth definitions
+: ` [compile] "" pad "copy pad ;
+
+variable >cld >cld off \ helps forward referencing cold
+
+metaon meta definitions
+max-kernel 40 + alloc-mem target-image \ Allocate space for the target image
+
+\ org sets the lowest address that is used by Forth kernel.
+\ This is sort of a funny number, being a target token rather
+\ than a real absolute address.
+0.0000 org 0.0000 voc-link-t token-t!
+
+initmeta
+ps-size-t equ ps-size
+rs-size-t equ rs-size
+
+assembler
+\ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+\ !!!!!!!!!!!!!!! the processor starts right here !!!!!!!!!!
+\ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+mlabel cld
+ lnk r6
+ dec r6,#0x10 \ header address in r6
+ 0 asm, \ space for a branch and link, to be patched in later
+meta
+0 a,-t
+h# 10 allot-t \ register saving area, reserved for internals
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1986 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/metainit.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/metarel.fth
===================================================================
--- cpu/arm/metarel.fth (rev 0)
+++ cpu/arm/metarel.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,40 @@
+purpose: Maintain a relocation table
+\ See license at end of file
+
+\needs lbsplit fload ${BP}/fm/lib/split.fth
+
+max-kernel d# 32 / constant /relocation-map \ Number of bytes in bitmap
+create relocation-map /relocation-map allot
+
+\ The relocation map has one bit for every 32-bit word, since we assume
+\ that relocated longwords must start on a 32-bit boundary
+
+: >offset ( adr -- offset ) /l / ;
+: meta-set-relocation-bit ( adr -- adr )
+ dup >offset relocation-map bitset
+;
+: meta-init-relocation ( -- ) relocation-map /relocation-map 0 fill ;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2008 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/metarel.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/minifth.fth
===================================================================
--- cpu/arm/minifth.fth (rev 0)
+++ cpu/arm/minifth.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,1127 @@
+purpose: Forth-like peek/poke/memory-test monitor using only registers
+\ See license at end of file
+
+\ Requires the following external definitions:
+\ isa-io-pa ( -- n ) \ Returns the base address of IO space
+\ init-serial ( -- ) \ May destroy r0-r3
+\ getchar ( -- r0: char ) \ May destroy r0-r3
+\ putchar ( r0: char -- ) \ May destroy r0-r3
+
+\ The following code must run entirely from registers. The following
+\ register allocation conventions are used:
+\ r0-r3 Argument passing and return, scratch registers for subroutines
+\ r4 Return address for level 1 routines, scratch use for level 2+
+\ r5 Return address for level 2 routines, scratch use for level 3+
+\ r6-r7 Used as needed within higher-level subroutines
+\ r8 Global state flags - bitmasks are:
+\ 1 - spin mode
+\ 2 - quiet mode
+\ 4 - script mode
+\ 8 - no-echo mode
+\ r9 script pointer
+\ r10-r13 4-element stack
+\ r14 Link register for subroutine calls
+\ r15 Program counter
+
+\ Send a space character to the output device.
+label putspace ( -- ) \ Level 0, destroys: r0-r3 (because it calls putchar)
+ mov r0,#0x20
+ b `putchar`
+end-code
+
+\ Send a newline sequence (CR-LF) to the output device.
+label putcr ( -- ) \ Level 1, destroys: r0-r4 (because it calls putchar)
+ mov r4,lr
+ mov r0,#0x0d
+ bl `putchar`
+ mov r0,#0x0a
+ bl `putchar`
+ mov pc,r4
+end-code
+
+\ Send ": " to the output device.
+label putcolon ( -- ) \ Level 1, destroys: r0-r4
+ mov r4,lr
+ mov r0,`char : #`
+ bl `putchar`
+ bl `putspace`
+ mov pc,r4
+end-code
+
+\ Accept input characters, packing up to 8 of them into the register pair
+\ r0,r1. The first character is placed in the least-significant byte of
+\ r1, and for each subsequent character, the contents of r0,r1 are shifted
+\ left by 8 bits to make room for the new character (shifting the most-
+\ significant byte of r1 into the least-significant byte of r0).
+\ A backspace character causes r0,r1 to be shifted right, discarding the
+\ previous character.
+\ The process terminates when a space or carriage return is seen. The
+\ terminating character is not stored in r0,r1. Any unused character
+\ positions in r0,r1 contain binary 0 bytes.
+label getword ( -- r0,r1 ) \ Level 4, destroys r0-r7
+ mov r5,lr
+ mov r6,#0 \ Clear high temporary holding register
+ mov r7,#0 \ Clear low temporary holding register
+
+ begin
+ tst r8,#4 0<> if
+ ldrb r0,[r9],#1
+ \ Translate linefeed to carriage return in script mode
+ cmp r0,#0x0a = if mov r0,#0x0d then
+ else
+ bl `getchar` ( char in r0 )
+ then
+
+ cmp r0,#0x0d = if \ carriage return
+ tst r8,#8 0= if \ Check no-echo flag
+ bl `putcr` \ Echo CR-LF
+ then
+ mov r0,r6 mov r1,r7 \ Return packed word in r0,r1
+ mov pc,r5 \ Return
+ then
+
+ cmp r0,`control h` <> if
+ cmp r0,#0x20 <= if \ white space
+ tst r8,#8 0= if \ Check no-echo flag
+ \ In quiet mode, echo the input character; otherwise echo CR-LF
+ tst r8,#2 0<> if bl `putchar` else bl `putcr` then
+ then
+ mov r0,r6 mov r1,r7 \ Return packed word in r0,r1
+ mov pc,r5 \ Return
+ then
+ then
+
+ mov r4,r0 \ Save character
+ tst r8,#8 0= if \ Check no-echo flag
+ bl `putchar` \ Echo the character
+ then
+
+ cmp r4,`control h` = if
+ \ Double-shift right one byte
+ mov r7,r7,lsr #8
+ orr r7,r7,r6,lsl #24
+ mov r6,r6,lsr #8
+ else
+ \ Double-shift left one byte and merge in the new character
+ mov r6,r6,lsl #8
+ orr r6,r6,r7,lsr #24
+ orr r7,r4,r7,lsl #8
+ then
+ again
+end-code
+
+\ Convert the ASCII hexadecimal characters packed into r0,r1 into a
+\ 32-bit binary number, returning the result in r0 and non-zero in r1
+\ if the operation succeeded.
+\ If the operation failed (because of the presence of non-hex characters),
+\ return 0 in r1, and an undefined value in r0.
+
+\ Level 1, destroys: r0-r4
+label convert-number ( r0,r1: ascii -- r0: binary r1: okay? )
+ mov r4,r0 \ Move high 4 ASCII characters away from r0
+ mov r0,#0 \ Accumulator for output
+
+ mov r3,#8 \ Loop counter - convert 8 nibbles
+ begin
+ \ Shift r4,r1 left one byte, putting result in r2
+ mov r2,r4,lsr #24 \ High byte in r2
+ mov r4,r4,lsl #8 \ Shift high word
+ orr r4,r4,r1,lsr #24 \ Merge from low word to high word
+ mov r1,r1,lsl #8 \ Shift low word
+
+ cmp r2,#0 <> if
+
+ cmp r2,`char 0 #`
+ movlt r1,#0
+ movlt pc,lr \ Exit if < '0'
+
+ cmp r2,`char 9 #` <= if \ Good digit from 0-9
+ sub r2,r2,`char 0 #`
+ else
+ cmp r2,`char A #`
+ movlt r1,#0
+ movlt pc,lr \ Exit if < 'A'
+
+ cmp r2,`char F #` <= if
+ sub r2,r2,`char A d# 10 - #`
+ else
+ cmp r2,`char a #` \ possibly lower case hex digit
+ movlt r1,#0
+ movlt pc,lr \ Exit if < 'a'
+
+ cmp r2,`char f #`
+ movgt r1,#0
+ movgt pc,lr \ Exit if > 'f'
+
+ sub r2,r2,`char a d# 10 - #`
+ then
+ then
+ add r0,r2,r0,lsl #4
+ then
+ decs r3,1
+ = until
+
+ mvn r1,#0
+
+ mov pc,lr
+end-code
+
+\ Display the number in r0 as an 8-digit unsigned hexadecimal number
+label dot ( r0 -- ) \ Level 3, destroys: r0-r6
+ mov r4,lr
+ mov r5,r0
+ mov r6,#8
+ begin
+ mov r5,r5,ror #28
+ and r0,r5,#0xf
+ cmp r0,#10
+ addge r0,r0,`char a d# 10 - #`
+ addlt r0,r0,`char 0 #`
+ bl `putchar`
+ decs r6,1
+ 0= until
+
+ mov r0,#0x20
+ bl `putchar`
+
+ mov pc,r4
+end-code
+
+transient
+\ Macros for managing the mini-stack
+: pop1 ( -- )
+ " mov r10,r11 mov r11,r12 mov r12,r13" evaluate
+;
+: pop2 ( -- )
+ " mov r10,r12 mov r11,r13 mov r12,r13" evaluate
+;
+: pop3 ( -- )
+ " mov r10,r13 mov r11,r13 mov r12,r13" evaluate
+;
+: push1 ( -- )
+ " mov r13,r12 mov r12,r11 mov r11,r10" evaluate
+;
+
+\ Macros to assemble code to begin and end command definitions
+8 buffer: name-buf
+
+\ Start a command definition
+\ false value trace?
+: t: ( "name" -- cond )
+ \ Get a name from the input stream at compile time and pack it
+ \ into a buffer in the same form it will appear in the register
+ \ pair when the mini-interpreter is executed at run-time
+ name-buf 8 erase ( )
+ parse-word ( adr len )
+\ no-page 2dup type space
+ dup 8 - 0 max /string ( adr' len' ) \ Keep last 8
+ 8 min 8 over - name-buf + swap move ( )
+
+\ ['] $do-undefined behavior .name cr
+ \ Assemble code to compare the register-pair contents against the name.
+ name-buf be-l@ " set r2,* cmp r0,r2" evaluate
+ name-buf 4 + be-l@ " set r2,* cmpeq r1,r2 = if" evaluate
+;
+
+
+\ End a command definition by:
+\ a) Assembling code to jump back to the beginning of the loop after the
+\ current definition has executed ("over again")
+\ b) Resolve the "if" (conditional branch) that skips the current definition
+\ if the name the user has entered does not match this definition.
+
+: t; ( loop-begin-adr if-adr --- loop-begin-adr )
+ " over again then" evaluate
+;
+resident
+
+label put-string ( -- )
+ mov r4,lr
+ begin
+ ldrb r0,[r4],#1
+ cmp r0,#0
+ <> while
+ bl `putchar`
+ repeat
+
+ add r4,r4,#3 \ Align to word boundary
+ bic r4,r4,#3
+
+ mov pc,r4
+end-code
+
+\ Some system architectures place the boot ROM at a non-zero physical
+\ address, in which case there must be a special "boot mode" that forces
+\ zero-based addresses to hit the ROM until some action is taken to turn
+\ off that mode. jump-to-rom adds the "real" physical address of the
+\ ROM to the return address so that it returns to the real physical address,
+\ after which it will be safe to turn off boot mode.
+label jump-to-rom
+ bic lr,lr,#0xff000000 \ In case we jump to the start address
+ set r0,`rom-pa #`
+ add pc,lr,r0
+end-code
+
+label minifth ( -- <does not return> ) \ Level 5
+ bl `jump-to-rom` \ Returns at the "real" ROM address
+
+ bl `init-serial`
+
+ bl `put-string`
+ banner$ c$, 4 (align)
+
+ mov r10,#0 mov r11,#0 mov r12,#0 mov r13,#0 \ Init stack
+ mov r8,#0 \ Init loop flag
+
+ begin ( loop-begin-adr )
+ tst r8,#6 0= if \ Display stack if neither silent nor scripting
+ \ mov r0,r13 bl `dot`
+ mov r0,r12 bl `dot`
+ mov r0,r11 bl `dot`
+ mov r0,r10 bl `dot`
+ mov r0,`char o #` bl `putchar`
+ mov r0,`char k #` bl `putchar`
+ bl `putspace`
+ then
+
+ bl `getword` \ Result in r0 and r1
+
+ \ If the word is null (i.e. a bare space or return), do nothing
+ cmp r0,#0 cmpeq r1,#0
+ yet <> until \ Branch back to the "begin" if r0,r1 = 0
+
+ t: showstack ( -- )
+ bic r8,r8,#2
+ t;
+
+ t: quiet ( -- )
+ orr r8,r8,#2
+ t;
+
+ t: clear ( ?? -- )
+ mov r10,#0 mov r11,#0 mov r12,#0 mov r13,#0 \ Init stack
+ t;
+
+ t: @ ( adr -- n )
+ tst r8,#1 <> if
+ begin ldr r0,[r10] again
+ then
+ ldr r10,[r10]
+ t;
+
+ t: ! ( n adr -- )
+ tst r8,#1 <> if
+ begin str r11,[r10] again
+ then
+ str r11,[r10]
+ pop2
+ t;
+
+ t: !@ ( n adr -- n' )
+ tst r8,#1 <> if
+ begin str r11,[r10] ldr r0,[r10] again
+ then
+ str r11,[r10]
+ ldr r10,[r10]
+ mov r11,r12 mov r12,r13
+ t;
+
+ t: @@ ( adr2 adr1 -- n2 n1 )
+ tst r8,#1 <> if
+ begin ldr r0,[r10] ldr r1,[r11] again
+ then
+ ldr r10,[r10]
+ ldr r11,[r11]
+ t;
+
+ t: !! ( n2 adr2 n1 adr1 -- )
+ tst r8,#1 <> if
+ begin str r11,[r10] str r13,[r12] again
+ then
+ str r11,[r10] str r13,[r12]
+ \ There's no reason to fix the stack because the arguments
+ \ filled it up.
+ t;
+
+ t: !!@ ( n1 adr1 n2 adr2 -- n3 )
+ tst r8,#1 <> if
+ begin str r11,[r10] str r13,[r12] ldr r0,[r10] again
+ then
+ str r11,[r10] str r13,[r12] ldr r10,[r10]
+ \ There's no reason to fix the stack because the arguments
+ \ filled it up.
+ t;
+
+ t: l@ ( adr -- l )
+ tst r8,#1 <> if
+ begin ldr r0,[r10] again
+ then
+ ldr r10,[r10]
+ t;
+
+ t: l! ( l adr -- )
+ tst r8,#1 <> if
+ begin str r11,[r10] again
+ then
+ str r11,[r10]
+ pop2
+ t;
+
+ t: l!@ ( n adr -- n' )
+ tst r8,#1 <> if
+ begin str r11,[r10] ldr r0,[r10] again
+ then
+ str r11,[r10]
+ ldr r10,[r10]
+ mov r11,r12 mov r12,r13
+ t;
+
+ t: c@ ( adr -- b )
+ tst r8,#1 <> if
+ begin ldrb r0,[r10] again
+ then
+ ldrb r10,[r10]
+ t;
+
+ t: c! ( b adr -- )
+ tst r8,#1 <> if
+ begin strb r11,[r10] again
+ then
+ strb r11,[r10]
+ pop2
+ t;
+
+ t: c!@ ( b adr -- b' )
+ tst r8,#1 <> if
+ begin strb r11,[r10] ldrb r0,[r10] again
+ then
+ strb r11,[r10]
+ ldrb r10,[r10]
+ mov r11,r12 mov r12,r13
+ t;
+
+ t: w@ ( adr -- w )
+ tst r8,#1 <> if
+ begin ldrh r0,[r10] again
+ then
+ ldrh r10,[r10]
+ t;
+
+ t: w! ( w adr -- )
+ tst r8,#1 <> if
+ begin strh r11,[r10] again
+ then
+ strh r11,[r10]
+ pop2
+ t;
+
+ t: w!@ ( n adr -- n' )
+ tst r8,#1 <> if
+ begin strh r11,[r10] ldrh r0,[r10] again
+ then
+ strh r11,[r10]
+ ldrh r10,[r10]
+ mov r11,r12 mov r12,r13
+ t;
+
+[ifdef] isa-io-pa
+ t: pc@ ( port# -- b )
+ set r0,`isa-io-pa #`
+ tst r8,#1 <> if
+ begin ldrb r1,[r10,r0] again
+ then
+
+ ldrb r10,[r10,r0]
+ t;
+
+ t: pc! ( b port# -- )
+ set r0,`isa-io-pa #`
+ tst r8,#1 <> if
+ begin strb r11,[r10,r0] again
+ then
+ strb r11,[r10,r0]
+ pop2
+ t;
+
+ t: pw@ ( port# -- w )
+ set r0,`isa-io-pa #`
+ tst r8,#1 <> if
+ begin ldrh r1,[r10,r0] again
+ then
+ ldrh r10,[r10,r0]
+ t;
+
+ t: pw! ( w port# -- )
+ set r0,`isa-io-pa #`
+ tst r8,#1 <> if
+ begin strh r11,[r10,r0] again
+ then
+ strh r11,[r10,r0]
+ pop2
+ t;
+
+ t: pl@ ( port# -- l )
+ set r0,`isa-io-pa #`
+ tst r8,#1 <> if
+ begin ldr r1,[r10,r0] again
+ then
+ ldr r10,[r10,r0]
+ t;
+
+ t: pl! ( l port# -- )
+ set r0,`isa-io-pa #`
+ tst r8,#1 <> if
+ begin str r11,[r10,r0] again
+ then
+ str r11,[r10,r0]
+ pop2
+ t;
+[then]
+
+ t: + ( n1 n2 -- n1+n2 )
+ add r10,r11,r10 mov r11,r12 mov r12,r13
+ t;
+
+ t: - ( n1 n2 -- n1-n2 )
+ sub r10,r11,r10 mov r11,r12 mov r12,r13
+ t;
+
+ t: and ( n1 n2 -- n1&n2 )
+ and r10,r11,r10 mov r11,r12 mov r12,r13
+ t;
+
+ t: or ( n1 n2 -- n1|n2 )
+ orr r10,r11,r10 mov r11,r12 mov r12,r13
+ t;
+
+ t: xor ( n1 n2 -- n1^n2 )
+ eor r10,r11,r10 mov r11,r12 mov r12,r13
+ t;
+
+ t: lshift ( n1 n2 -- n1<<n2 )
+ mov r10,r11,lsl r10 mov r11,r12 mov r12,r13
+ t;
+
+ t: rshift ( n1 n2 -- n1>>n2 )
+ mov r10,r11,lsr r10 mov r11,r12 mov r12,r13
+ t;
+
+ t: invert ( n -- ~n )
+ mvn r10,r10
+ t;
+
+ t: negate ( n -- -n )
+ rsb r10,r10,#0
+ t;
+
+ t: spin ( -- ) \ Modifies next @/!-class command to loop forever
+ mov r8,#1
+ t;
+
+ t: * ( n1 n2 -- n1*n2 )
+ mul r10,r11,r10 mov r11,r12 mov r12,r13
+ t;
+
+ t: . ( n -- )
+ mov r0,r10
+ bl `dot`
+ bl `putcr`
+ pop1
+ t;
+
+ t: move ( src dst len -- )
+ cmp r10,#0
+ <> if
+ cmp r11,r12
+ u< if
+ begin
+ ldrb r0,[r12],#1
+ strb r0,[r11],#1
+ decs r10,1
+ 0= until
+ else
+ begin
+ decs r10,1
+ ldrb r0,[r12,r10]
+ strb r0,[r11,r10]
+ 0= until
+ then
+ then
+ pop3
+ t;
+
+ t: compare ( adr1 adr2 len -- -1 | offset )
+ mov r1,r10 \ Save len for later
+ mvn r0,#0 \ -1 - provisional return value
+ inc r10,1
+ begin
+ decs r10,1
+ 0> while
+ ldrb r2,[r11],#1
+ ldrb r3,[r12],#1
+ cmp r2,r3
+ subne r0,r1,r10
+ <> until
+ then
+ pop3
+ push1
+ mov r10,r0
+ t;
+
+ t: fill ( adr len b -- )
+ begin
+ decs r11,1
+ strgeb r10,[r12],#1
+ < until
+ pop3
+ t;
+
+ t: check ( adr len b -- )
+ begin
+ decs r11,1
+ >= while
+ ldrb r7,[r12],#1
+ cmp r7,r10
+ <> if
+ sub r0,r12,#1 bl `dot`
+ bl `putcolon`
+ mov r0,r7 bl `dot`
+ bl `putcr`
+ then
+ repeat
+ pop3
+ t;
+
+ t: test ( adr len b -- )
+ mov r0,r10
+ mov r1,r11
+ mov r2,r12
+ begin
+ decs r11,1
+ strgeb r10,[r12],#1
+ < until
+ mov r10,r0
+ mov r11,r1
+ mov r12,r2
+ begin
+ decs r11,1
+ >= while
+ ldrb r7,[r12],#1
+ cmp r7,r10
+ <> if
+ sub r0,r12,#1 bl `dot`
+ bl `putcolon`
+ mov r0,r7 bl `dot`
+ bl `putcr`
+ then
+ repeat
+ pop3
+ t;
+
+ t: lfill ( adr len l -- )
+ begin
+ decs r11,4
+ strge r10,[r12],#4
+ < until
+ pop3
+ t;
+
+ t: lcheck ( adr len l -- )
+ begin
+ decs r11,4
+ >= while
+ ldr r7,[r12],#4
+ cmp r7,r10
+ <> if
+ sub r0,r12,#4 bl `dot`
+ bl `putcolon`
+ mov r0,r7 bl `dot`
+ bl `putcr`
+ then
+ repeat
+ pop3
+ t;
+
+ t: ltest ( adr len l -- )
+ mov r0,r10
+ mov r1,r11
+ mov r2,r12
+ begin
+ decs r11,4
+ strge r10,[r12],#4
+ < until
+ mov r10,r0
+ mov r11,r1
+ mov r12,r2
+ begin
+ decs r11,4
+ >= while
+ ldr r7,[r12],#4
+ cmp r7,r10
+ <> if
+ sub r0,r12,#4 bl `dot`
+ bl `putcolon`
+ mov r0,r7 bl `dot`
+ bl `putcr`
+ then
+ repeat
+ pop3
+
+ t;
+
+ t: afill ( adr len -- )
+ begin
+ decs r10,4
+ strge r11,[r11],#4
+ < until
+ pop2
+ t;
+
+ t: acheck ( adr len -- )
+ begin
+ decs r10,4
+ >= while
+ ldr r7,[r11]
+ cmp r7,r11
+ <> if
+ mov r0,r11 bl `dot`
+ bl `putcolon`
+ mov r0,r7 bl `dot`
+ bl `putcr`
+ then
+ add r11,r11,#4
+ repeat
+ pop2
+ t;
+
+ t: atest
+ mov r0,r10
+ mov r1,r11
+ begin
+ decs r10,4
+ strge r11,[r11],#4
+ < until
+ mov r10,r0
+ mov r11,r1
+ begin
+ decs r10,4
+ >= while
+ ldr r7,[r11]
+ cmp r7,r11
+ <> if
+ mov r0,r11 bl `dot`
+ bl `putcolon`
+ mov r0,r7 bl `dot`
+ bl `putcr`
+ then
+ add r11,r11,#4
+ repeat
+ pop2
+ t;
+
+ t: sum ( adr len -- checksum )
+ set r0,0
+ begin
+ decs r10,1
+ ldrgeb r1,[r11],#1
+ addge r0,r0,r1
+ < until
+ pop2
+ push1
+ mov r10,r0
+ t;
+
+ t: erase ( adr len -- )
+ set r0,0
+ begin
+ decs r10,1
+ strgeb r0,[r11],#1
+ < until
+ pop2
+ t;
+
+ t: dump ( adr len -- )
+ begin
+ decs r10,1
+ >= while
+ mov r0,r11 bl `dot`
+ bl `putcolon`
+ ldrb r0,[r11],#1 bl `dot`
+ bl `putcr`
+ repeat
+ pop2
+ t;
+
+ t: ldump ( adr len -- )
+ begin
+ decs r10,4
+ >= while
+ mov r0,r11
+ bl `dot`
+ bl `putcolon`
+ ldr r0,[r11],#4
+ bl `dot`
+ bl `putcr`
+ repeat
+ pop2
+ t;
+
+ t: dup ( n -- n n )
+ mov r13,r12 mov r12,r11 mov r11,r10
+ t;
+
+ t: drop ( n -- )
+ mov r10,r11 mov r11,r12 mov r12,r13
+ t;
+
+ t: swap ( n1 n2 -- n2 n1 )
+ mov r0,r11 mov r11,r10 mov r10,r0
+ t;
+
+ t: over ( n1 n2 -- n1 n2 n1 )
+ mov r13,r12 mov r12,r11 mov r11,r10 mov r10,r12
+ t;
+
+ t: rot ( n1 n2 n3 -- n2 n3 n1 )
+ mov r0,r12 mov r12,r11 mov r11,r10 mov r10,r0
+ t;
+
+ t: -rot ( n1 n2 n3 -- n3 n1 n2 )
+ mov r0,r12 mov r12,r10 mov r10,r11 mov r11,r0
+ t;
+
+ t: icache-on ( -- )
+ mrc p15, 0, r0, cr1, cr0, 0 \ write the control register
+ orr r0, r0, #0x1000 \ Turn on the icache
+ mcr p15, 0, r0, cr1, cr0, 0 \ write the control register
+ t;
+
+ t: icache-off ( -- )
+ mrc p15, 0, r0, cr1, cr0, 0 \ write the control register
+ bic r0, r0, #0x1000 \ Turn off the icache
+ mcr p15, 0, r0, cr1, cr0, 0 \ write the control register
+ t;
+
+ \ Turning on the dcache and write buffer are not so simple, because
+ \ the MMU must be on first.
+
+ t: control@ ( -- n )
+ push1
+ mrc p15, 0, r10, cr1, cr0, 0 \ read the control register
+ t;
+
+ t: control! ( n -- )
+ mcr p15, 0, r10, cr1, cr0, 0 \ write the control register
+ pop1
+ t;
+
+ t: script ( address -- )
+ mov r9,r10
+ orr r8,r8,#0xc \ Set script and no-echo flags
+ pop1
+ t;
+
+ t: rom-script ( offset -- )
+ add r9,r10,`rom-pa #`
+ orr r8,r8,#0xc \ Set script and no-echo flags
+ pop1
+ t;
+
+ t: fexit ( -- )
+ bic r8,r8,#0xc \ Clear script and no-echo flags
+ t;
+
+ t: scripts ( -- )
+ mov r6,#0
+ set r7,`rom-pa h# 10000 + #`
+ begin
+ ldrb r0,[r7]
+ cmp r0,`ascii \ #` \ If the script aread begings
+ = if \ with a comment character
+ \ display "s#: "
+ mov r0,`ascii s #` bl `putchar`
+ add r0,r6,`ascii 0 #` bl `putchar`
+ mov r0,`ascii : #` bl `putchar`
+ bl `putspace`
+ begin \ display the first comment line
+ ldrb r0,[r7],1 \ Get comment byte
+ cmp r0,#0x0d \ Carriage return?
+ cmpne r0,#0x0a \ Line feed?
+ <> while
+ bl `putchar`
+ repeat
+ bl `putcr`
+ then
+ mov r7,r7,lsr #12 \ Clear low bits
+ mov r7,r7,lsl #12
+ add r7,r7,#0x1000 \ Advance to next script
+ add r6,r6,#1
+ cmp r6,#10
+ = until
+ t;
+
+ t: s0 ( -- )
+ set r9,`rom-pa h# 10000 + #`
+ orr r8,r8,#0xc \ Set script and no-echo flags
+ t;
+
+ t: s1 ( -- )
+ set r9,`rom-pa h# 11000 + #`
+ orr r8,r8,#0xc \ Set script and no-echo flags
+ t;
+
+ t: s2 ( -- )
+ set r9,`rom-pa h# 12000 + #`
+ orr r8,r8,#0xc \ Set script and no-echo flags
+ t;
+
+ t: s3 ( -- )
+ set r9,`rom-pa h# 13000 + #`
+ orr r8,r8,#0xc \ Set script and no-echo flags
+ t;
+
+ t: s4 ( -- )
+ set r9,`rom-pa h# 14000 + #`
+ orr r8,r8,#0xc \ Set script and no-echo flags
+ t;
+
+ t: s5 ( -- )
+ set r9,`rom-pa h# 15000 + #`
+ orr r8,r8,#0xc \ Set script and no-echo flags
+ t;
+
+ t: s6 ( -- )
+ set r9,`rom-pa h# 16000 + #`
+ orr r8,r8,#0xc \ Set script and no-echo flags
+ t;
+
+ t: s7 ( -- )
+ set r9,`rom-pa h# 17000 + #`
+ orr r8,r8,#0xc \ Set script and no-echo flags
+ t;
+
+ t: s8 ( -- )
+ set r9,`rom-pa h# 18000 + #`
+ orr r8,r8,#0xc \ Set script and no-echo flags
+ t;
+
+ t: s9 ( -- )
+ set r9,`rom-pa h# 19000 + #`
+ orr r8,r8,#0xc \ Set script and no-echo flags
+ t;
+
+ \ The original intention of "no-echo" and its inverse "echo" was
+ \ to create a capability like "dl" whereby one could download a
+ \ script over the serial line, but without requiring the use of
+ \ memory. However, this has the serious problem that there is
+ \ no flow control, so commands that can take a long time (like
+ \ memory tests) potentially cause input overrun. Consequently,
+ \ it's better to use quiet mode. However, quiet mode has its own
+ \ problem: few if any terminal programs support its character-echo
+ \ flow control technique. Character-echo flow control is not
+ \ particularly great anyway - it can be fooled by generated output
+ \ that happens to contain the next input character.
+ t: no-echo ( -- )
+ orr r8,r8,#0x8 \ Set no-echo flag
+ t;
+
+ t: echo ( -- )
+ bic r8,r8,#0x8 \ Clear no-echo flag
+ t;
+
+ t: cr ( -- )
+ bl `putcr`
+ t;
+
+ t: key ( -- char )
+ bl `getchar`
+ push1 mov r10,r0
+ t;
+
+ t: emit ( char -- )
+ mov r0,r10
+ bl `putchar`
+ pop1
+ t;
+
+ \ This is useful for diagnostics in script mode, but essentially
+ \ useless otherwise.
+ t: .( ( "string" -- )
+ begin
+ tst r8,#4 0<> if \ Script mode
+ ldrb r0,[r9],#1
+ else \ Normal mode
+ bl `getchar` ( char in r0 )
+ then
+ cmp r0,`char ) #`
+ <> while
+ bl `putchar`
+ repeat
+ t;
+
+ \ This is useful for commentary in script mode, but essentially
+ \ useless otherwise.
+ t: \ ( "rest-of-line" -- )
+ begin
+ tst r8,#4 0<> if \ Script mode
+ ldrb r0,[r9],#1
+ else \ Normal mode
+ bl `getchar` ( char in r0 )
+ then
+ cmp r0,#0x0a
+ cmpne r0,#0x0d
+ = until
+ t;
+
+ t: goto ( address -- )
+ mov pc,r10
+ t;
+
+ t: gettext ( address -- length )
+ mov r4,r10
+ begin
+ bl `getchar`
+ cmp r0,#4 \ Control-D (ASCII EOT)
+ <> while
+ strb r0,[r4],#1
+ repeat
+
+ sub r10,r4,r10
+ t;
+
+ t: getbytes ( address length -- )
+ begin
+ decs r10,1
+ 0>= while
+ bl `getchar`
+ strb r0,[r11],#1
+ repeat
+ pop2
+ t;
+
+[ifdef] init-sequoia
+ t: seq@ ( reg# -- w )
+ set r0, `isa-io-pa #`
+ tst r8,#1 <> if
+ begin strh r10,[r0, #0x24] ldrh r10,[r0,#0x26] again
+ then
+ strh r10, [r0, #0x24] \ Point to the register
+ ldrh r10, [r0, #0x26] \ Get the data
+ t;
+
+ t: seq! ( w reg# -- )
+ set r0, `isa-io-pa #`
+ tst r8,#1 <> if
+ begin strh r10,[r0, #0x24] strh r11,[r0,#0x26] again
+ then
+ strh r10, [r0, #0x24] \ Point to the register
+ strh r11, [r0, #0x26] \ Get the data
+ pop2
+ t;
+[then]
+
+[ifdef] rom-pa
+ t: rom ( -- adr )
+ push1 set r10,`rom-pa #`
+ t;
+[then]
+
+[ifdef] isa-io-pa
+ t: io ( -- adr )
+ push1 set r10,`isa-io-pa #`
+ t;
+[then]
+
+[ifdef] mem0-pa
+ t: mem0 ( -- adr )
+ push1 set r10,`mem0-pa #`
+ t;
+[then]
+
+[ifdef] mem1-pa
+ t: mem1 ( -- adr )
+ push1 set r10,`mem1-pa #`
+ t;
+[then]
+
+[ifdef] mem2-pa
+ t: mem2 ( -- adr )
+ push1 set r10,`mem2-pa #`
+ t;
+[then]
+
+[ifdef] mem3-pa
+ t: mem3 ( -- adr )
+ push1 set r10,`mem3-pa #`
+ t;
+[then]
+
+ t: 1m ( -- n )
+ push1 mov r10,#0x100000
+ t;
+
+ t: 1m ( -- n )
+ push1 mov r10,#0x100000
+ t;
+
+ t: 1m ( -- n )
+ push1 mov r10,#0x100000
+ t;
+
+ t: 2m ( -- n )
+ push1 mov r10,#0x200000
+ t;
+
+ t: 4m ( -- n )
+ push1 mov r10,#0x400000
+ t;
+
+ t: 8m ( -- n )
+ push1 mov r10,#0x800000
+ t;
+
+ t: 16m ( -- n )
+ push1 mov r10,#0x1000000
+ t;
+
+ t: 32m ( -- n )
+ push1 mov r10,#0x2000000
+ t;
+
+
+ \ The word was not recognized; parse it as a number or complain
+ bl `convert-number` cmp r1,#0 <> if \ Number in r0
+ \ Push the number
+ push1 mov r10,r0 ( -- n )
+ else
+ \ The word was neither recognized nor numeric; complain
+ mov r0,`char ? #` bl `putchar` bl `putcr`
+ then
+
+ again
+
+end-code
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/minifth.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/mmu.fth
===================================================================
--- cpu/arm/mmu.fth (rev 0)
+++ cpu/arm/mmu.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,317 @@
+purpose: ARM MMU driver
+\ See license at end of file
+
+\ Definition:
+\ PTE: Page Table Entry - a page descriptor - a 32 number that goes in
+\ a level-2 page table.
+\ PMEG: Page Map Entry Group - a level-2 page table - a group of 256
+\ page table entries.
+
+0 value st-va
+h# 400 constant /pmeg
+h# 10.0000 constant /section
+
+\ Read and write section-table entries.
+: >section ( va -- smadr ) d# 20 rshift st-va swap la+ ;
+: section@ ( va -- ste ) >section l@ ;
+: section! ( ste va -- ) >section l! ;
+
+0 constant st-imp \ 0 or h# 10 - "imp" bit setting
+0 5 lshift constant fw-domain
+h# c02 fw-domain or constant ste-lowbits \ AP=11, C=0, B=0,
+
+0 value pmeg-pa \ Physical address page selector bits for current PMEG
+0 value 'pt-ent \ Location of the pte that is used for mapping ptes
+
+0 value pmeg-section-va \ Virtual address of section used for PMEG access
+
+\ Returns the virtual address where the selected PMEG can be accessed
+: pmeg-va ( -- adr ) pmeg-pa pmeg-section-va or ;
+
+\ Select the PMEG at pmeg-pa by setting the section entry for
+\ pmeg-section-va to refer to it.
+: map-pmeg ( ste|pmeg-pa -- )
+ h# 3ff invert and dup h# 000f.f000 and to pmeg-pa
+ pmeg-section-va flush-d-tlb-entry \ Blast the old entry
+ h# f.f000 invert and ste-lowbits or pmeg-section-va section!
+;
+
+\ Convert a level-1 (section) map entry to a level-2 (page) map entry
+\ with the same permissions and beginning page number. This is used
+\ when converting a section-level mapping to page-level mappings.
+: ste>pte ( ste -- pte )
+ dup h# fff0.000f and swap ( base/cb l1-pte )
+ h# c00 and dup 2 rshift or ( base/cb ap3/2 )
+ dup 4 rshift or or ( base/ap3/2/1/0/cb )
+;
+
+\ Allocate memory for a new page map entry group, install it in the
+\ section table at the appropriate location for va, and create a
+\ temporary virtual mapping for it so we can access it, returning its
+\ temporary virtual address.
+: get-pmeg ( va -- )
+ /pmeg /pmeg mem-claim ( va pte-pa )
+ tuck fw-domain or st-imp or 1 or ( pte-pa va ste )
+ swap section! ( pte-pa )
+ map-pmeg ( )
+;
+
+\ Create a new page map entry group for the section contaning va,
+\ initializing it to consecutive physical pages using base-pte as
+\ a template. To create initially-invalid entries, use 0 for base-pte.
+: new-pmeg ( va base-pte -- )
+ swap get-pmeg ( base-pte adr )
+ pmeg-va /pmeg bounds do dup i l! pagesize + /l +loop ( pte )
+ drop ( )
+;
+
+0 value remapping? \ True if a newly-allocated PMEG will loaded with
+ \ new entries.
+: set-pmeg ( va -- )
+ dup section@ dup 3 and case ( va ste type )
+ 1 of ( va ste )
+ nip map-pmeg ( )
+ endof ( )
+ 2 of ( va ste )
+ ste>pte new-pmeg ( )
+ endof ( )
+ ( default ) ( va ste type )
+ remapping? if ( va ste type )
+ \ We are going to create mappings in the range,
+ \ so create a new PMEG and prime it with invalid PTEs.
+ nip swap 0 new-pmeg ( type )
+ else ( va ste type )
+ \ If we are going to unmap the range
+ \ and it's already unmapped, leave it so.
+ nip nip ( type )
+ then ( type )
+ ( end default ) ( type )
+ endcase ( )
+;
+
+: (pte-setup) ( va -- adr ) d# 10 rshift h# 3fc and pmeg-va + ;
+: (pte!) ( pte va -- ) (pte-setup) l! ;
+: (pte@) ( va -- pte ) (pte-setup) l@ ;
+
+: >pt ( va -- true | offset pte-page-pa false )
+ dup section@ dup 3 and 1 = if ( va ste )
+ h# 3ff invert and ( va pte-page-pa )
+ swap d# 10 rshift h# 3fc and swap ( offset pte-page-pa )
+ false
+ else
+ 2drop true
+ then
+;
+
+: .cb ( s/pment -- )
+ dup 8 and if ." Cacheable" then
+ 4 and if ." Buffered" then
+;
+: .domain ( ste -- ) ." Domain: " d# 5 rshift h# f and . ;
+: .ap ( n bit# -- n ) over swap rshift 3 and (.) type ;
+: .l1-mapping ( va ste -- )
+ push-hex
+ ." Section-mapped - Physical: " ( va ste )
+ swap h# fffff and over h# fffff invert and or 8 u.r ( ste )
+ ." AP: " d# 10 .ap space ( ste )
+ dup .domain ( ste )
+ dup h# 10 and if ." IMP" then ( ste )
+ .cb ( )
+ cr
+ pop-base
+;
+: .l2-mapping ( va ste -- )
+ push-hex
+ ." PMEG at: " dup h# ffff.fc00 and 8 u.r ( va ste )
+ dup .domain ( va ste )
+ map-pmeg dup (pte@) cr ( va pte )
+ dup 3 and 1 2 between if ( va pte )
+ dup 3 and 1 = if ( va pte )
+ ." 64K" h# ffff ( va pte mask )
+ else ( va pte )
+ ." 4K" h# 0fff ( va pte mask )
+ then ( va pte mask )
+ ." Physical: " rot over and ( pte mask val )
+ -rot invert over and rot or 8 u.r ( pte )
+ ." AP: " ( pte )
+ d# 10 .ap ." ," 8 .ap ." ," 6 .ap ." ," 4 .ap space ( pte )
+ .cb ( )
+ else ( va pte )
+ 2drop ." Not Mapped" ( )
+ then ( )
+ cr
+ pop-base
+;
+
+: map? ( va -- )
+ dup section@ dup 3 and case ( va ste type )
+ 1 of .l2-mapping endof
+ 2 of .l1-mapping endof
+ ( default: va ste type )
+ ." Not mapped at section level" 3drop exit
+ endcase
+;
+
+\ "Circular arithmetic" max and min. In circular arithmetic, 0 is greater
+\ than ff00.0000. The use of these operators instead of umax and umin
+\ correctly handles the case where an address range ends at 2^^32, which
+\ looks like 0 in 32-bit twos-complement arithmetic.
+: cmax ( adr1 adr2 -- max ) 2dup - 0> if drop else nip then ;
+: cmin ( adr1 adr2 -- min ) 2dup - 0< if drop else nip then ;
+
+\ Break the range into three ranges -
+\ The range on top of the stack goes from adr up to the first section boundary
+\ The middle range goes from the first to the last section boundary
+\ The last range goes from the last section boundary to adr+len
+\ Some ranges may be zero-length
+: split-range ( adr len -- end end-sec end-sec start-sec start-sec start )
+ bounds ( end start )
+ over /section round-down over cmax tuck swap ( end end-sec end-sec start )
+ 2dup /section round-up cmin tuck swap
+ ( end end-sec end-sec start-sec start-sec start )
+;
+
+: ?set-pmeg ( end start -- end start ) 2dup <> if dup set-pmeg then ;
+
+: ?release-pmeg ( va -- va )
+ dup section@ 3 and 1 = if \ Reclaim old PMEG ( va )
+ dup section@ h# ffff.fc00 and /pmeg mem-release ( va )
+ then ( va )
+;
+: invalidate-page ( va -- ) 0 swap (pte!) ;
+: invalidate-section ( va -- ) ?release-pmeg 0 swap section! ;
+
+: remap-pages ( mode pa va-end va-start -- mode pa' )
+ ?do ( mode pa )
+ over ste>pte over or i (pte!) ( mode pa )
+ pagesize + ( mode pa' )
+ pagesize +loop ( mode pa' )
+;
+
+: remap-sections ( pa mode va-end va-start mode -- pa' mode )
+ ?do ( mode pa )
+ dup h# f.f000 and if ( mode pa )
+ \ Physical not aligned; use page-level mappings
+ i section@ 3 and 1 = if \ Reuse old PMEG ( mode pa )
+ i section@ map-pmeg ( mode pa )
+ else \ Allocate a new PMEG ( mode pa )
+ i get-pmeg ( mode pa )
+ then ( mode pa )
+ i /section bounds remap-pages ( mode pa' )
+ else ( mode pa )
+ \ Physical is aligned; use section-level mappings
+ i ?release-pmeg drop ( mode pa )
+ 2dup or i section! ( mode pa )
+ /section + ( mode pa' )
+ then ( mode pa' )
+ /section +loop ( mode pa )
+;
+
+: remap-range ( phys mode adr len -- )
+ true to remapping?
+ 2swap 2 or swap h# fff invert and ( adr len mode pa )
+ 2>r split-range 2r> ( d.r2 d.r1 d.r0 mode pa )
+
+ 2swap ?set-pmeg remap-pages ( d.r2 d.r1 mode pa' )
+ 2swap ?set-pmeg remap-sections ( d.r2 mode pa' )
+ 2swap ?set-pmeg remap-pages ( mode pa' )
+
+ 2drop ( )
+;
+
+\ XXX Perhaps we should invalidate the cache within this range.
+: unmap-range ( adr len -- )
+ 2dup invalidate-cache-range
+ false to remapping?
+ split-range ( d.range2 d.range1 d.range0 )
+ ?set-pmeg ?do i invalidate-page pagesize +loop ( d.range2 d.range1 )
+ ?do i invalidate-section /section +loop ( d.range2 )
+ ?set-pmeg ?do i invalidate-page pagesize +loop ( )
+;
+
+: (shootdown-range) ( adr len -- )
+ over swap 2>r ( adr r: adr len )
+ translate ( false | phys mode true r: adr len )
+ if 2r> remap-range else 2r> unmap-range then
+ flush-i&d-tlb
+;
+' (shootdown-range) to shootdown-range
+
+: (map-mode) ( phys.. mode -- mode' )
+ >r memory? r> ( memory? mode )
+ dup -2 -1 between if ( memory? -1 )
+ drop if ( )
+ h# c0c \ Memory: AC=3, C=1, B=1
+ else ( )
+ h# c00 \ I/O: AC=3, C=0, B=0
+ then ( mode' )
+ else ( memory? mode )
+ nip ( mode )
+ then ( mode' )
+;
+' (map-mode) to map-mode
+
+headerless
+list: translations-list
+
+\ After initial-mmu-setup exits, the mmu must be on and st-va must
+\ be set to the virtual address of the section table.
+defer initial-mmu-setup ( -- ) ' noop to initial-mmu-setup
+defer initial-claim ( -- ) ' noop to initial-claim
+defer initial-map ( -- ) ' noop to initial-map
+
+: init-virtual-list ( -- )
+ 0 memrange ! \ Clear free list
+
+ \ Create the available memory list from which the firmware is allowed
+ \ to dynamically allocate virtual memory.
+
+ fw-virt-base fw-virt-size set-node fwvirt insert-after
+
+ \ Setup the virtual list from which the firmware isn't permitted to allocate
+ 0 fw-virt-base add-os-piece
+ fw-virt-base fw-virt-size + 0 add-os-piece
+;
+
+headers
+warning off
+: open ( -- )
+ initial-mmu-setup \ Do platform-specific stuff as necessary
+
+ init-virtual-list
+
+ initial-claim \ Claim any pre-committed platform-specific addresses
+
+ \ Grab a Meg of virtual address space to use for temporary PMEG access
+ /section /section claim to pmeg-section-va
+
+ translations-list to translations
+
+ initial-map \ Set up platform-specific hardcoded translations
+ true
+;
+warning on
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/mmu.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/muldiv.fth
===================================================================
--- cpu/arm/muldiv.fth (rev 0)
+++ cpu/arm/muldiv.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,366 @@
+purpose: Multiply and divide
+\ See license at end of file
+
+[ifdef] fixme
+0 value StrongARM?
+[else]
+0 value arm4?
+[then]
+
+hex
+code * ( n1 n2 -- n3 ) pop r0,sp mul tos,r0,tos c;
+code u* ( u1 u2 -- u3 ) pop r0,sp mul tos,r0,tos c;
+
+code um* ( u1 u2 -- ud )
+[ifdef] fixme
+ ldr r0,'user StrongARM?
+[else]
+ ldr r0,'user arm4?
+[then]
+ cmp r0,#0
+ <> if
+ pop r4,sp
+ umull r1,r0,tos,r4
+ psh r1,sp
+ mov tos,r0
+ next
+ then
+ mov r6,#0xff
+ orr r6,r6,#0xff00
+ and r0,r6,tos \ r0: lu2
+ and r1,r6,tos,lsr #0x10 \ r1: tu2
+ ldr tos,[sp]
+ and r2,r6,tos \ r2: lu1
+ and r3,r6,tos,lsr #0x10 \ r3: tu1
+
+ mul r4,r0,r2 \ low
+ mul r6,r0,r3 \ interm
+ mul tos,r1,r3 \ upper
+ mul r0,r1,r2 \ interm
+
+ adds r0,r0,r6
+ inccs tos#0x10000
+ adds r4,r4,r0,lsl #0x10
+ adc tos,tos,r0,lsr #0x10 \ adding CARRY
+ str r4,[sp]
+c;
+
+code m* ( n1 n2 -- d )
+[ifdef] fixme
+ ldr r0,'user StrongARM?
+[else]
+ ldr r0,'user arm4?
+[then]
+ cmp r0,#0
+ <> if
+ pop r4,sp
+ smull r1,r0,tos,r4
+ psh r1,sp
+ mov tos,r0
+ next
+ then
+ mov r5,#0 \ clear change-sign flag
+ mov r6,#0xff
+ orr r6,r6,#0xff00
+ cmps tos,#0
+ rsblt tos,tos,#0
+ mvnlt r5,r5 \ setting flag
+ and r0,r6,tos \ r0: lu2
+ and r1,r6,tos,lsr #0x10 \ r1: tu2
+ pop tos,sp
+ cmps tos,#0
+ rsblt tos,tos,#0
+ mvnlt r5,r5
+ and r2,r6,tos \ r2: lu1
+ and r3,r6,tos,lsr #0x10 \ r3: tu1
+
+ mul r4,r0,r2 \ low
+ mul r6,r0,r3 \ interm
+ mul tos,r1,r3 \ upper
+ mul r0,r1,r2 \ interm
+
+ adds r0,r0,r6
+ inccs tos,#0x10000
+ adds r4,r4,r0,lsl #0x10
+ adc tos,tos,r0,lsr #0x10 \ adding CARRY
+ cmps r5,#0
+ <> if
+ decs r4,#1
+ sbc tos,tos,#0
+ mvn r4,r4
+ mvn tos,tos
+ then
+ psh r4,sp
+c;
+
+\ (32/32division) does a 32/32bit unsigned division
+\ r0 / tos = r0.rem tos.quot
+code (32/32division)
+ mov r3,#1
+\ cmp tos,#0
+\ ' divide-error dolink eq branch
+ begin
+ cmp tos,#0x80000000
+ cmpcc tos,r0
+ movcc tos,tos,lsl #1
+ movcc r3,r3,lsl #1
+ u>= until
+ mov r2,#0
+ begin
+ cmp r0,tos
+ subcs r0,r0,tos
+ addcs r2,r2,r3
+ movs r3,r3,lsr #1
+ movne tos,tos,lsr #1
+ 0= until
+ mov tos,r2
+ mov pc,lk
+end-code
+
+code (u64division)
+ stmdb sp!,{r7,r8,r9}
+ mov r6,#0
+ mov r7,#1
+ mov r4,#0
+ mov r5,#0
+ orrs r8,r2,r3
+\ ' divide-error bleq *
+ begin
+ cmp r2,#0x80000000
+ u< if
+ cmp r2,r0
+ cmpeq r3,r1
+ u< if
+ mov r2,r2,lsl #1
+ orr r2,r2,r3,lsr #0x1f
+ mov r3,r3,lsl #1
+ mov r6,r6,lsl #1
+ orr r6,r6,r7,lsr #0x1f
+ mov r7,r7,lsl #1
+ then
+ then
+ u>= until
+ begin
+ cmp r0,r2
+ cmpeq r1,r3
+ u>= if
+ subs r1,r1,r3
+ sbc r0,r0,r2
+ adds r5,r5,r7
+ adc r4,r4,r6
+ then
+ movs r6,r6,lsr #1
+ mov r7,r7,ror #0
+ orrs r8,r6,r7
+ 0<> if
+ movs r2,r2,lsr #1
+ mov r3,r3,ror #0
+ then
+ orrs r8,r6,r7
+ 0= until
+ ldmia sp!,{r7,r8,r9}
+ mov pc,lk
+end-code
+
+\ unsigned 64/64bit division (u64division)
+\ r0 -> r0.h-r1.l r1 -> r2.h-r3.l
+\ r2 -> r4.h-r5.l r3 -> r6.h-r7.l
+\ r01 / r23 = r01.rem r45.quot
+code du/mod ( ud1 ud2 -- du.rem du.quot )
+ mov r2,tos
+ pop r3,sp
+ pop r0,sp
+ pop r1,sp
+ bl 'code (u64division)
+ psh r1,sp
+ psh r0,sp
+ psh r5,sp
+ mov tos,r4
+c;
+
+code um/mod ( ud u1 -- u.rem u.quot )
+ mov r2,#0
+ mov r3,tos
+
+ pop r0,sp
+ pop r1,sp
+ bl 'code (u64division)
+ psh r1,sp
+ mov tos,r5
+c;
+code mu/mod ( ud u1 -- u.rem ud.quot )
+ mov r2,#0
+ mov r3,tos
+ pop r0,sp
+ pop r1,sp
+ bl 'code (u64division)
+ psh r1,sp
+ psh r5,sp
+ mov tos,r4
+c;
+
+code fm/mod ( d.dividend s.divisor -- s.rem s.quot )
+ mov r3,tos
+ mov r2,tos,asr #0 \ sign extend divisor
+ pop r0,sp
+ pop r1,sp
+ stmdb sp!,{r8,r9}
+ cmp r0,#0
+ < if
+ rsbs r1,r1,#0
+ rsc r0,r0,#0
+ cmp r2,#0
+ < if
+ rsbs r3,r3,#0
+ rsc r2,r2,#0
+ bl 'code (u64division)
+ rsbs r1,r1,#0
+ rsc r0,r0,#0
+ else
+ mov r8,r2
+ mov r9,r3
+ bl 'code (u64division)
+ rsbs r5,r5,#0
+ rsc r4,r4,#0
+ orrs tos,r0,r1
+ 0<> if
+ subs r5,r5,#1
+ sbc r4,r4,#0
+ subs r1,r9,r1
+ sbc r0,r8,r0
+ then
+ then
+ else
+ cmp r2,#0
+ < if
+ mov r8,r2
+ mov r9,r3
+ rsbs r3,r3,#0
+ rsc r2,r2,#0
+ bl 'code (u64division)
+ rsbs r5,r5,#0
+ rsc r4,r4,#0
+ orrs tos,r0,r1
+ 0<> if
+ subs r5,r5,#1
+ sbc r4,r4,#0
+ adds r1,r1,r9
+ adc r0,r0,r8
+ then
+ else
+ bl 'code (u64division)
+ then
+ then
+ ldmia sp!,{r8,r9}
+ psh r1,sp
+ mov tos,r5
+c;
+
+code u/mod ( u.dividend u.divisor -- u.rem u.quot )
+ ldr r0,[sp]
+ ' (32/32division) bl * \ r0 / tos = r0.rem tos.quot
+ str r0,[sp]
+c;
+
+code /mod ( n.dividend s.divisor -- s.rem s.quot )
+ ldr r0,[sp]
+ cmp r0,#0
+ < if
+ rsb r0,r0,#0
+ cmp tos,#0
+ < if
+ rsb tos,tos,#0
+ bl 'code (32/32division) \ r0 / tos = r0.rem tos.quot
+ rsb r0,r0,#0
+ else
+ mov r4,tos
+ bl 'code (32/32division) \ r0 / tos = r0.rem tos.quot
+ rsb tos,tos,#0
+ cmp r0,#0
+ decne tos,#1
+ subne r0,r4,r0
+ then
+ else
+ cmp tos,#0
+ < if
+ mov r4,tos
+ rsb tos,tos,#0
+ bl 'code (32/32division) \ r0 / tos = r0.rem tos.quot
+ rsb tos,tos,#0
+ cmp r0,#0
+ decne tos,#1
+ addne r0,r0,r4
+ else
+ bl 'code (32/32division) \ r0 / tos = r0.rem tos.quot
+ then
+ then
+ str r0,[sp]
+c;
+
+code sm/rem ( d.dividend s.divisor -- s.rem s.quot )
+ mov r3,tos
+ mov r2,tos,asr #0
+ pop r0,sp
+ pop r1,sp
+ cmp r0,#0 \ dividend <0
+ < if
+ rsbs r1,r1,#0
+ rsc r0,r0,#0
+ cmp r2,#0 \ divisor <0
+ < if
+ rsbs r3,r3,#0
+ rsc r2,r2,#0
+ bl 'code (u64division)
+ rsbs r1,r1,#0
+ rsc r0,r0,#0
+ else
+ bl 'code (u64division)
+ rsbs r1,r1,#0
+ rsc r0,r0,#0
+ rsbs r5,r5,#0
+ rsc r4,r4,#0
+ then
+ else
+ cmp r2,#0 \ divisor <0
+ < if
+ rsbs r3,r3,#0
+ rsc r2,r2,#0
+ bl 'code (u64division)
+ rsbs r5,r5,#0
+ rsc r4,r4,#0
+ else
+ bl 'code (u64division)
+ then
+ then
+ psh r1,sp
+ mov tos,r5
+c;
+
+: / ( dividend divisor -- quotient ) /mod nip ;
+: mod ( dividend divisor -- modulus ) /mod drop ;
+: */mod ( n1 n2 n3 -- n.mod n.quot ) >r m* r> fm/mod ;
+: */ ( n1 n2 n3 -- n4 ) */mod nip ;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/muldiv.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/native.bth
===================================================================
--- cpu/arm/native.bth (rev 0)
+++ cpu/arm/native.bth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,10 @@
+purpose: Build file for native.dic
+
+dictionary: ${BP}/cpu/arm/build/tools.dic
+command: &armforth &dictionary &this
+build-now
+
+fload ${BP}/ofw/tokenizer/tokenize.fth
+fload ${BP}/forth/lib/builder.fth
+
+.( --- Saving native.dic --- ) cr "" native.dic save-forth
Property changes on: cpu/arm/native.bth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/objcode.fth
===================================================================
--- cpu/arm/objcode.fth (rev 0)
+++ cpu/arm/objcode.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,101 @@
+purpose: Code words for support of multiple-code-field objects
+\ See license at end of file
+
+code >code-adr ( acf -- code-adr )
+ r0 top ) ldr
+ r0 r0 8 #lsl mov
+ top top r0 6 #asr add
+ top 2 cells incr c;
+
+\ As i understand your high-level definition of >action-adr
+\ it assumes action to be: 0 < action# <= #actions, is this ok?
+\ Testing for action#=0 not necessary?
+
+code >action-adr ( object-acf action# -- ... )
+( ... -- object-acf action# #actions true | object-apf action-adr false )
+\ !!!! the next line should ONLY be included for RiscOS Forthmacs testing
+\ BASE 'body origin pcr ldr
+ r1 sp ) ldr \ r1: object-acf top: action#
+
+ r0 r1 ) ldr \ r0: object-code-field
+ r0 r0 8 #asl mov \ remove opcode bits
+ r0 r1 r0 6 #asr add \ r0: adr of object ;code clause - 8
+
+ \ adding /cell is the same as adding
+ \ 8 then subtracting 4
+ r0 /cell incr \ r0: object-#actions-adr r1: obj-acf
+
+ r2 r0 ) ldr \ r2: #actions
+ top r2 cmp \ action# greater #actions
+gt if top r2 2 sp db! stm \ push action# and #actions
+ top -1 # mov \ return true
+ next
+then \ r0: object-#actions-adr r1: object-acf r2: #actions top: action#
+
+ r0 r0 top 2 #asl sub \ r0: adr of action cell
+ r0 r0 ) ldr \ r0: action-adr
+\ r0 r0 BASE add
+ \ r0: object-action-adr r1: object-acf top: action#
+ r1 /cell incr \ r1: object-apf
+ r1 sp ) str \ put object-apf on stack
+ r0 sp push \ push action-adr
+ top 0 # mov c; \ return false
+
+\ Object data structure:
+\
+\ Created by object defining words (actions, action:, etc):
+\
+\ tokenN-1 tokenN-1 ... token1 #actions (does-clause) ...
+\ |________|________|________|________|________|________
+
+: action-name \ name ( action# -- )
+ create ,
+ ;code
+\ !!!! the next line should ONLY be included for RiscOS Forthmacs testing
+ \ BASE 'body origin pcr ldr \ Test
+\ r0 top ) ldr \ r0: action#
+
+ r0 get-link
+ r0 r0 ) ldr \ r0: action#
+
+ r2 ip )+ ldr
+\ r2 r2 BASE add \ r2: object-acf
+ top sp push \ make room on stack
+ top r2 /cell # add \ top: object-apf
+
+ r3 r2 ) ldr \ r3: object-code-field
+ r3 r3 8 #lsl mov \ remove opcode bits
+ r3 r2 r3 6 #asr add \ r3: adr of object ;code clause - 8
+ r3 2 cells incr \ r3:object-code-adr
+
+ r0 1 incr \ r0: index to action-cell
+ r3 r3 r0 2 #asl sub \ r3: adr of action cell
+\ I am not sure about implementing execute, here the pc is just
+\ set to token@
+ pc r3 ) ldr \ execute action
+\ pc r3 BASE add
+c;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2006 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/objcode.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/objsup.fth
===================================================================
--- cpu/arm/objsup.fth (rev 0)
+++ cpu/arm/objsup.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,109 @@
+purpose: Machine dependent support routines used for the objects package.
+\ See license at end of file
+
+\ These words know intimate details about the Forth virtual machine
+\ implementation.
+
+\ Assembles the common code executed by actions. That code
+\ extracts the next token (which is the acf of the object) from the
+\ code stream and leaves the corresponding apf on the stack.
+
+headerless
+
+: start-code ( -- ) code-cf !csp ;
+
+\ Assembles code to begin a ;code clause
+: start-;code ( -- ) start-code ;
+
+\ Code field for an object action.
+: doaction ( -- ) acf-align colon-cf ;
+
+code >action-adr ( object-acf action# -- ... )
+( ... -- object-acf action# #actions true | object-apf action-adr false )
+\ !!!! the next line should ONLY be included for RiscOS Forthmacs testing
+\ ldr base,[pc,`'body origin swap here 8 + - swap']
+ ldr r1,[sp] \ r1: object-acf top: action#
+
+ ldr r0,[r1] \ r0: object-code-field
+ mov r0,r0,lsl #8 \ remove opcode bits
+ add r0,r1,r0,asr #6 \ r0: adr of object ;code clause - 8
+
+ \ adding /cell is the same as adding
+ \ 8 then subtracting 4
+ inc r0,1cell \ r0: object-#actions-adr r1: obj-acf
+
+ ldr r2,[r0] \ r2: #actions
+ cmp tos,r2 \ action# greater #actions
+ > if
+ stmdb sp!,{tos,r2} \ push action# and #actions
+ mvn tos,#0 \ return true
+ next
+ then
+
+ \ r0: object-#actions-adr r1: object-acf r2: #actions tos: action#
+ sub r0,r0,tos,lsl #2 \ r0: adr of action cell
+ ldr r0,[r0] \ r0: action-adr
+\ add r0,r0,base
+
+ \ r0: object-action-adr r1: object-acf tos: action#
+ inc r1,1cell \ r1: object-apf
+ str r1,[sp] \ put object-apf on stack
+ psh r0,sp \ push action-adr
+ mov tos,#0 \ return false
+c;
+
+headers
+: action-name \ name ( action# -- )
+ create ,
+ ;code
+\ !!!! the next line should ONLY be included for RiscOS Forthmacs testing
+\ ldr base,[pc,`'body origin swap here 8 + - swap`] \ Test
+\ ldr r0,[tos] \ r0: action#
+
+ lnk r0
+ ldr r0,[r0] \ r0: action#
+
+ ldr r2,[ip],1cell
+\ add r2,r2,base \ r2: object-acf
+ psh tos,sp \ make room on stack
+ add tos,r2,1cell \ tos: object-apf
+
+ ldr r3,[r2] \ r3: object-code-field
+ mov r3,r3,lsl #8 \ remove opcode bits
+ add r3,r2,r3,asr #6 \ r3: adr of object ;code clause - 8
+ inc r3,2cells \ r3:object-code-adr
+
+ inc r0,#1 \ r0: index to action-cell
+ sub r3,r3,r0,lsl #2 \ r3: adr of action cell
+\ I am not sure about implementing execute, here the pc is just
+\ set to token@
+ ldr pc,[r3] \ execute action
+\ add pc,r3,base
+c;
+
+: >action# ( apf -- action# ) @ ;
+headers
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/objsup.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/psr.fth
===================================================================
--- cpu/arm/psr.fth (rev 0)
+++ cpu/arm/psr.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,54 @@
+purpose: Access functions for processor status register
+\ See license at end of file
+
+code psr@ ( -- n ) psh tos,sp mrs tos,cpsr c;
+code psr! ( n -- ) msr cpsr,tos pop tos,sp c;
+
+h# 80 constant interrupt-enable-bit
+: interrupt-enable@ ( -- n ) psr@ interrupt-enable-bit and ;
+: interrupt-enable! ( n -- ) psr@ interrupt-enable-bit invert and or psr! ;
+
+headerless
+: (disable-interrupts) ( -- ) psr@ interrupt-enable-bit or psr! ;
+: (enable-interrupts) ( -- ) psr@ interrupt-enable-bit invert and psr! ;
+: interrupts-enabled? ( -- yes? ) interrupt-enable@ 0= ;
+
+code (lock) ( -- ) ( R: -- oldMSR )
+ mrs r0,cpsr
+ psh r0,rp
+ orr r0,r0,#0x80
+ msr cpsr,r0
+c;
+code (unlock) ( -- ) ( R: oldMSR -- )
+ pop r0,rp
+ msr cpsr,r0
+c;
+
+' (enable-interrupts) to enable-interrupts
+' (disable-interrupts) to disable-interrupts
+' (lock) to lock[
+' (unlock) to ]unlock
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/psr.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/regacc.fth
===================================================================
--- cpu/arm/regacc.fth (rev 0)
+++ cpu/arm/regacc.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,36 @@
+purpose: Register access words for ARM
+\ See license at end of file
+
+\ We assume that all devices of interest are mapped with write-buffering
+\ disabled.
+
+alias rl@ l@ ( addr -- l )
+alias rl! l! ( l addr -- )
+alias rw@ w@ ( addr -- w )
+alias rw! w! ( w addr -- )
+alias rb@ c@ ( addr -- b )
+alias rb! c! ( b addr -- )
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/regacc.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/register.fth
===================================================================
--- cpu/arm/register.fth (rev 0)
+++ cpu/arm/register.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,420 @@
+purpose: Common code to managed saved program state
+\ See license at end of file
+
+\ Requires:
+\
+\ >state ( offset -- addr )
+\ Returns an address within the processor state array given the
+\ offset into that array
+\
+\ Defines:
+\
+\ register names
+\ .registers
+
+needs action: objects.fth
+
+decimal
+headerless
+
+only forth hidden also forth also definitions
+
+\ GP regs PSR state-stuff
+d# 16 1+ 4 +
+
+[ifdef] save-fp-regs
+8 3 * +
+[then]
+
+/l* constant /save-area
+
+: state-valid ( -- addr ) d# 40 /l* >state ;
+: ?saved-state ( -- )
+ state-valid @ 0= abort" No program state has been saved in this session."
+;
+
+: clear-save-area ( -- ) 0 >state /save-area erase ;
+
+: >vmem ;
+
+3 actions
+action: @ ?saved-state >state @ ;
+action: @ >state ! ; ( is )
+action: @ >state ; ( addr )
+: reg \ name ( offset -- )
+ create /l* ,
+ use-actions
+;
+: regs \ name name ... ( start #regs -- )
+ bounds ?do i reg loop
+;
+
+[ifdef] save-fp-regs
+: l at + ( adr -- l adr' ) dup l@ swap la1+ ;
+: l!- ( l adr -- adr' ) tuck l! -1 la+ ;
+3 actions
+action: @ ?saved-state >state l at + l at + l at + ;
+action: @ >state 2 la+ l!- l!- l!- ; ( is )
+action: @ >state ; ( addr )
+: freg \ name ( offset -- )
+ create /l* ,
+ use-actions
+;
+: fregs \ name name ... ( start #regs -- )
+ 3 * bounds ?do i freg 3 +loop
+;
+[then]
+
+headers
+[ifdef] new-frame
+ 0 1 regs psr
+
+ 1 8 regs r0 r1 r2 r3 r4 r5 r6 r7
+ 9 8 regs r8 r9 r10 r11 r12 r13 r14 r15
+
+10 4 regs up tos rp ip
+14 3 regs sp lr pc
+16 1 regs rpc
+[else]
+ 0 8 regs r0 r1 r2 r3 r4 r5 r6 r7
+ 8 8 regs r8 r9 r10 r11 r12 r13 r14 r15
+
+ 9 4 regs up tos rp ip
+13 3 regs sp lr pc
+15 1 regs rpc
+
+16 1 regs psr
+[then]
+
+17 1 regs exception-psr
+18 3 regs %saved-my-self %state-valid %restartable?
+
+[ifdef] save-fp-regs
+21 8 fregs f0 f1 f2 f3 f4 f5 f6 f7
+[then]
+
+\ Following words defined here to satisfy the
+\ references to these "variables" anywhere else
+: saved-my-self ( -- addr ) addr %saved-my-self ;
+: restartable? ( -- addr ) addr %restartable? ;
+
+headerless
+: .lx ( l -- ) base @ >r hex 9 u.r r> base ! ;
+
+: .mode ( n -- )
+ case
+ h# 10 of ." User32" endof
+ h# 11 of ." FIQ32" endof
+ h# 12 of ." IRQ32" endof
+ h# 13 of ." SVC32" endof
+ h# 17 of ." Abort32" endof
+ h# 1b of ." Undef32" endof
+ h# 1f of ." System32" endof
+ endcase
+;
+headers
+: .psr ( -- )
+ psr " nzcv~~~~~~~~~~~~~~~~~~~~ift~~~~~" show-bits
+ ." _" psr h# 1f and .mode
+;
+: .registers ( -- )
+ ?saved-state
+ ??cr
+." r0 r1 r2 r3 r4 r5 r6 r7" cr
+ r0 .lx r1 .lx r2 .lx r3 .lx r4 .lx r5 .lx r6 .lx r7 .lx
+cr cr
+." r8 r9/up r10/tos r11/rp/fp r12/ip r13/sp r14/lr pc" cr
+ r8 .lx r9 .lx r10 .lx r11 .lx r12 .lx r13 .lx r14 .lx r15 .lx
+cr cr
+." PSR = " .psr
+cr
+;
+
+headerless
+only forth also hidden also forth definitions
+
+: enterforth ( -- )
+ state-valid on
+ my-self to %saved-my-self
+ handle-breakpoint
+;
+
+also arm-assembler definitions
+: 'state ( "name" -- )
+ r0 drop rb-field
+ [ also forth ]
+ safe-parse-word ['] forth $vfind 0= abort" Bad saved register name"
+ >body @
+ [ previous ]
+ set-offset
+;
+previous definitions
+
+h# e600.0010 value breakpoint-opcode
+
+\ The is the first half of the state restoration procedure. It executes
+\ in normal state (e.g user state when running under an OS)
+code (restart ( -- )
+ \ Restore the Forth stacks.
+
+ \ Establish the Data and Return stacks
+ ldr rp,'user rp0
+ ldr sp,'user sp0
+
+ \ Restore the Forth Data and Return stacks from the save area.
+
+ \ Data Stack
+ ldr r3,'user sp0
+ dec r3,`ps-size #` \ Address of data stack area
+ ldr r0,'user pssave \ Address of data stack save area
+ mov r1,`ps-size /l / #` \ Size of data stack area in longwords
+
+ begin
+ ldr r2,[r0],1cell
+ str r2,[r3],1cell
+ subs r1,r1,#1
+ 0= until
+
+ \ Return Stack
+ ldr r3,'user rp0
+ dec r3,`rs-size #` \ Address of return stack area
+ ldr r0,'user rssave \ Address of return stack save area
+ mov r1,`rs-size /l / #` \ Size of return stack area in longwords
+
+ begin
+ ldr r2,[r0],1cell
+ str r2,[r3],1cell
+ subs r1,r1,#1
+ 0= until
+
+ \ The following code communicates with the first part of "save-state".
+ \ See the description there.
+
+
+ \ Remember offset
+ here 'code (restart drop - >r
+
+ \ Take another trap, so we can fix up the PC's in the signal handler
+ breakpoint-opcode asm, \ Undefined instruction
+
+end-code
+
+r> constant restart-offset
+
+\ This is the second half of the state saving procedure. It executes
+\ in normal state (not exception state).
+
+label finish-save
+
+ \ Find the user area
+ adr up,'body main-task \ Get user pointer address
+ ldr up,[up] \ Get user pointer
+
+ \ Establish the Data and Return stacks
+
+ \ Copy the entire Forth Data and Return stacks areas to a save area.
+
+ \ Data Stack
+ ldr r3,'user sp0
+ dec r3,`ps-size #` \ Address of data stack area
+ ldr r0,'user pssave \ Address of data stack save area
+ mov r1,`ps-size /l / #` \ Size of data stack area in longwords
+
+ begin
+ ldr r2,[r3],1cell
+ str r2,[r0],1cell
+ subs r1,r1,#1
+ 0= until
+
+ ldr sp,'user sp0
+
+ \ Return Stack
+ ldr r3,'user rp0
+ dec r3,`rs-size #` \ Address of return stack area
+ ldr r0,'user rssave \ Address of return stack save area
+ mov r1,`rs-size /l / #` \ Size of return stack area in longwords
+
+ begin
+ ldr r2,[r3],1cell
+ str r2,[r0],1cell
+ subs r1,r1,#1
+ 0= until
+
+ ldr rp,'user rp0
+
+ \ Adjust the stack pointer to account for the top of stack register
+ inc sp,1cell
+
+ \ Restart the Forth interpreter.
+
+ \ Execute enterforth
+ adr ip,'body enterforth
+c;
+
+label restart-common
+ \ Entry: r13: cpu-state others: scratch
+
+ \ In the early part of this code, we don't have to be too careful
+ \ about register usage, because we will eventually restore all the
+ \ registers to saved values.
+
+ mov r0,r13 \ Get cpu-state address into r0
+
+ ldr r3,'state r13 \ Get r13 for return mode
+ ldr r4,'state r14 \ Get r14 for return mode
+
+ mrs r2,cpsr \ Get PSR for this mode
+ ldr r1,'state psr \ Get PSR for return mode
+ msr spsr,r1 \ Put it in place
+
+ tst r1,#0xf \ Check for user mode
+ orreq r1,r1,#0xf \ Set system mode if previous mode was user
+ orr r1,r1,#0x80 \ Disable interrupts
+ msr cpsr,r1 \ Get into the return mode
+
+ mov r13,r3 \ Set r13 in return mode
+ mov r14,r4 \ Set r14 in return mode
+
+ msr cpsr,r2 \ Get back into undef mode
+
+ ldr r14,'state pc \ Get PC for return mode
+
+ ldmia r0,{r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11,r12} \ Restore
+
+ \ Set the saved PC to point to the rest of the state save
+ \ routine, then return from interrupt.
+
+ movs pc,r14 \ Return from exception
+end-code
+
+label save-common
+ str r14,'state pc \ Save PC from previous context
+
+ mrs r2,cpsr \ Get PSR from this context
+ str r2,'state exception-psr \ Save exception PSR
+
+ mrs r1,spsr \ Get PSR from previous context
+ str r1,'state psr \ Save it
+
+ orr r3,r1,#0x80 \ Disable interrupts
+ tst r3,#0xf \ Check for user mode
+ orreq r3,r3,#0xf \ Set system mode if previous mode was user
+ msr cpsr,r3 \ Get into the old mode
+
+ str r13,'state r13 \ Save r13 from the old mode
+ str r14,'state r14 \ Save r14 from the old mode
+
+ msr cpsr,r2 \ Get back into undef mode
+
+ \ When we enter Forth, we want interrupts to be enabled if they were
+ \ enabled before the exception occurred, unless the exception was caused
+ \ by an unexpected interrupt.
+ and r1,r1,#0x80 \ Get interrupt disable bit from previous mode
+ bic r2,r2,#0x80 \ Clear interrupt disable bit
+ and r3,r2,#0xf \ Get mode type bits
+ cmp r3,#2 \ Interrupt? (unexpected or user-abort)
+ cmpeq r4,#0 \ User-abort? (r4 != 0 if user abort)
+ orreq r2,r2,#0x80 \ Set interrupt disable bit if unexp. int.
+ orrne r2,r2,r1 \ Merge old int. dis. bit into new mode
+
+ bic r2,r2,#0x1f \ Clear mode bits
+ orr r2,r2,#0x13 \ Set SVC32 mode
+ msr spsr,r2 \ Put it in SPSR so the return below puts
+ \ us back into the right mode for Forth
+
+ \ Set the saved PC to point to the rest of the state save
+ \ routine, then return from interrupt.
+
+ adr r14,'body finish-save
+
+ movs pc,r14 \ Return from exception
+end-code
+
+string-array exception-name
+( 00 ) ," Reset"
+( 01 ) ," Undefined Instruction"
+( 02 ) ," Software Interrupt"
+( 03 ) ," Prefetch Abort"
+( 04 ) ," Data Abort"
+( 05 ) ," Address Exception"
+( 06 ) ," Interrupt"
+( 07 ) ," Fast Interrupt"
+end-string-array
+
+hex
+create mode>exception
+\ 0 1 2 3 4 5 6 7
+ ff c, 7 c, 6 c, 2 c, ff c, ff c, ff c, 4 c,
+
+\ 8 9 a b c d e f
+ ff c, ff c, ff c, 1 c, ff c, ff c, ff c, ff c,
+
+: exception# ( -- )
+ exception-psr h# f and mode>exception + c@
+;
+
+: (.exception) ( -- )
+ exception# dup 7 < if
+ exception-name count type
+ else
+ ." Bogus exception # " .h
+ then
+ cr
+;
+' (.exception) is .exception
+
+[ifdef] notdef
+\ Very simple handler, useful before the full breakpoint mechanism is installed
+: print-breakpoint
+ .exception \ norm
+ interactive? 0= if bye then \ Restart only if a human is at the controls
+ ??cr quit
+;
+' print-breakpoint is handle-breakpoint
+[then]
+
+defer install-handler ( handler exception# -- )
+defer catch-exception ( exception# -- )
+
+headers
+: catch-exceptions ( -- )
+ /save-area alloc-mem is cpu-state
+ ps-size alloc-mem is pssave
+ rs-size alloc-mem is rssave
+
+ 1 catch-exception \ Undefined instruction
+\ 2 catch-exception \ Software interrupt
+ 3 catch-exception \ Prefetch abort
+ 4 catch-exception \ Data abort
+ 5 catch-exception \ 26-bit address exceptions
+ 6 catch-exception \ Interrupt
+ 7 catch-exception \ Fast Interrupt
+;
+
+headers
+
+only forth also definitions
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/register.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/savefort.fth
===================================================================
--- cpu/arm/savefort.fth (rev 0)
+++ cpu/arm/savefort.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,128 @@
+purpose: Save the Forth dictionary image in a file in ARM image format
+\ See license at end of file
+
+\ save-forth ( filename -- )
+\ Saves the Forth dictionary to a file so it may be later used under Unix
+\
+\ save-image ( header-adr header-len init-routine-name filename -- )
+\ Primitive save routine. Saves the dictionary image to a file.
+\ The header is placed at the start of the file. The latest definition
+\ whose name is the same as the "init-routine-name" argument is
+\ installed as the init-io routine.
+
+hex
+
+variable dictionary-size
+
+only forth also hidden also
+hidden definitions
+
+headerless
+
+: dict-size ( -- size-of-dictionary ) here origin - aligned ;
+: rel-size ( -- reloc-size ) dict-size d# 31 + d# 32 / ;
+
+headers
+
+only forth also hidden also
+forth definitions
+
+h# 80 buffer: aif-header
+ \ 00 NOP (BL decompress code)
+ \ 04 NOP (BL self reloc code)
+ \ 08 NOP (BL ZeroInit code)
+ \ 0c BL entry (or offset to entry point for non-executable AIF header)
+ \ 10 NOP (program exit instruction)
+ \ 14 0 (Read-only section size)
+ \ 18 Dictionary size, actual value will be set later
+ \ 1c Reloc Size (ARM Debug size)
+ \ 20 0 (ARM zero-init size)
+ \ 24 0 (image debug type)
+ \ 28 Reloc save base (image base)
+ \ 2c Dictionary growth size (min workspace size)
+ \ 30 d#32 (address mode)
+ \ 34 0 (data base address)
+ \ 38 reserved
+ \ 3c reserved
+ \ 40 NOP (debug init instruction)
+ \ 44-7c unused (zero-init code)
+
+decimal
+
+: aif! ( n offset -- ) aif-header + ! ;
+: nop! ( offset -- ) h# e1a00000 swap aif! ;
+
+headerless
+: $save-image ( header header-len filename$ -- )
+ $new-file ( header header-len )
+
+ relocation-off
+ \ There is no need to copy the user area to the initial user area
+ \ image because the user area is currently accessed in-place.
+
+ ( header header-len ) ofd @ fputs \ Write header
+ origin dict-size ofd @ fputs \ Write dictionary
+ relocation-map rel-size ofd @ fputs \ Write the relocation table
+ ofd @ fclose
+ relocation-on
+;
+: make-arm-header ( -- )
+ \ Build the header
+ aif-header h# 80 erase
+ h# 00 nop!
+ h# 04 nop!
+ h# 08 nop!
+ h# eb00001b h# 0c aif! \ branch to just after the header
+ h# ef000011 h# 10 aif! \ SWI_Exit
+ h# 80 h# 14 aif! \ Read-only image size = header size
+ dict-size rel-size + h# 18 aif! \ Read-write size
+ 0 h# 1c aif!
+ 0 h# 20 aif!
+ 0 h# 24 aif!
+ h# 8000 h# 28 aif! \ Load base
+ dictionary-size @ h# 8.0000 max h# 2c aif! \ Dictionary growth size
+ h# 20 h# 30 aif! \ 32-bit address mode
+ 0 h# 34 aif!
+\ dict-size h# 38 aif! \ Dictionary size (Using a reserved field!)
+\ origin h# 3c aif! \ Save base (Using a reserved field!)
+ h# 40 nop!
+ dict-size h# 10 origin+ ! \ Dictionary size
+ origin h# 14 origin+ ! \ Save base
+;
+headers
+
+\ Save an image of the target system in a file.
+: $save-forth ( str -- )
+ 2>r
+ make-arm-header
+ " sys-init-io" $find-name is init-io
+ " sys-init" init-save
+
+ aif-header h# 80 2r> $save-image
+;
+
+only forth also definitions
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/savefort.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/savemeta.fth
===================================================================
--- cpu/arm/savemeta.fth (rev 0)
+++ cpu/arm/savemeta.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,97 @@
+purpose: Save the metacompiled kernel into a relocatable binary
+\ See license at end of file
+
+\ Binary relocation table stuff
+\ The relocation information in a binary file appears after the data segment.
+\ The relocation table is a bit map with one bit for every 32-bit word
+\ in the binary image. A one bit means that the longword is to be relocated.
+
+\ Binary file header
+
+only forth labels also forth also definitions
+
+hex
+create aif-header forth
+ 80 allot aif-header 80 erase
+ \ 00 NOP (BL decompress code)
+ \ 04 NOP (BL self reloc code)
+ \ 08 NOP (BL ZeroInit code)
+ \ 0c BL entry
+ \ 10 NOP (program exit instruction)
+ \ 14 0 (Read-only section size)
+ \ 18 Dictionary size, actual value will be set later
+ \ 1c Reloc Size (ARM Debug size)
+ \ 20 0 (ARM zero-init size)
+ \ 24 0 (image debug type)
+ \ 28 Reloc save base (image base)
+ \ 2c Dictionary growth size (min workspace size)
+ \ 30 d#32 (address mode)
+ \ 34 0 (data base address)
+ \ 38 reserved
+ \ 3c reserved
+ \ 40 NOP (debug init instruction)
+ \ 44-7c unused (zero-init code)
+
+only forth also meta also forth-h also definitions
+
+: text-base ( -- adr-t ) origin-t ;
+: text-size ( -- n ) here-t text-base - ;
+: reloc-size ( -- n ) text-size 1f + 5 >> ;
+
+: aif! ( n offset -- ) aif-header + l-t! ;
+: nop! ( offset -- ) th e1a00000 swap aif! ;
+
+\ Save an image of the target system in a file.
+: $save-meta ( name$ -- )
+ $new-file
+ \ Build and output the header
+ 00 nop!
+ 04 nop!
+ 08 nop!
+ eb00001b 0c aif! \ branch to just after the header
+ ef000011 10 aif! \ SWI_Exit
+ 80 14 aif! \ Read-only image size = header size
+ text-size reloc-size + 18 aif! \ Read-write size
+ 0 1c aif!
+ 0 20 aif!
+ 0 24 aif!
+ 8000 28 aif! \ Relocation save base
+ 8.0000 2c aif! \ Dictionary growth size
+ 20 30 aif! \ 32-bit address mode
+ 0 34 aif!
+\ text-size 38 aif! \ Dictionary size (Using a reserved field!)
+\ 0 3c aif! \ Save base (Using a reserved field!)
+ 40 nop!
+ text-size origin-t h# 10 + l!-t \ Dictionary size
+ 0 origin-t h# 14 + l!-t \ Save base
+
+ aif-header 80 ofd @ fputs
+ text-base >hostaddr text-size ofd @ fputs \ Text image
+ relocation-map reloc-size ofd @ fputs \ Relocation map
+
+ ofd @ fclose
+;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2008 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/savemeta.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/scc.fth
===================================================================
--- cpu/arm/scc.fth (rev 0)
+++ cpu/arm/scc.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,114 @@
+purpose: System Control Coprocessor access words
+\ See license at end of file
+
+hex
+code scc-id@ ( -- n ) psh tos,sp mrc p15,0,tos,cr0,cr0,0 c;
+code control@ ( -- n ) psh tos,sp mrc p15,0,tos,cr1,cr0,0 c;
+code ttbase@ ( -- n ) psh tos,sp mrc p15,0,tos,cr2,cr0,0 c;
+code domain-access@ ( -- n ) psh tos,sp mrc p15,0,tos,cr3,cr0,0 c;
+code fault-status@ ( -- n ) psh tos,sp mrc p15,0,tos,cr5,cr0,0 c;
+code fault-address@ ( -- n ) psh tos,sp mrc p15,0,tos,cr6,cr0,0 c;
+
+code control! ( n -- ) mcr p15,0,tos,cr1,cr0,0 pop tos,sp c;
+code ttbase! ( n -- ) mcr p15,0,tos,cr2,cr0,0 pop tos,sp c;
+code domain-access! ( n -- ) mcr p15,0,tos,cr3,cr0,0 pop tos,sp c;
+code fault-status! ( n -- ) mcr p15,0,tos,cr5,cr0,0 pop tos,sp c;
+code fault-address! ( n -- ) mcr p15,0,tos,cr6,cr0,0 pop tos,sp c;
+code flush-i&d$ ( -- ) mcr p15,0,r0,cr7,cr7,0 c;
+code flush-i$ ( -- ) mcr p15,0,r0,cr7,cr5,0 c;
+code flush-d$ ( -- ) mcr p15,0,r0,cr7,cr6,0 c;
+code flush-d$-entry ( va -- ) mcr p15,0,tos,cr7,cr6,1 pop tos,sp c;
+code clean-d$-entry ( va -- ) mcr p15,0,tos,cr7,cr10,1 pop tos,sp c;
+code drain-write-buffer ( -- ) mcr p15,0,r0,cr7,cr10,4 c;
+code flush-i&d-tlb ( -- ) mcr p15,0,r0,cr8,cr7,0 c;
+code flush-i-tlb ( -- ) mcr p15,0,r0,cr8,cr5,0 c;
+code flush-d-tlb ( -- ) mcr p15,0,r0,cr8,cr6,0 c;
+code flush-d-tlb-entry ( va -- ) mcr p15,0,tos,cr8,cr6,1 pop tos,sp c;
+
+code enable-odd-lfsr ( -- ) mcr p15,0,r0,cr15,cr1,1 c;
+code enable-even-lfsr ( -- ) mcr p15,0,r0,cr15,cr2,1 c;
+code clear-lfsr ( -- ) mcr p15,0,r0,cr15,cr4,1 c;
+code lfsr-to-r14 ( -- ) mcr p15,0,r0,cr15,cr8,1 c;
+code fast-clock ( -- ) mcr p15,0,r0,cr15,cr1,2 c;
+code slow-clock ( -- ) mcr p15,0,r0,cr15,cr2,2 c;
+code disable-mclk ( -- ) mcr p15,0,r0,cr15,cr4,2 c;
+code wait-for-interrupt ( -- ) mcr p15,0,r0,cr15,cr8,2 c;
+
+: ttbase ( -- n ) ttbase@ h# 3ff invert and ;
+
+: .control ( -- ) control@ " i..rsb...wcam" show-bits ;
+
+d# 32 constant /cache-line
+: cache-bounds ( adr len -- end start )
+ bounds swap /cache-line round-up swap /cache-line round-down
+;
+: invalidate-cache-range ( adr len -- )
+ dup if flush-i$ then
+ cache-bounds ?do i flush-d$-entry /cache-line +loop
+;
+d# 32 constant /cache-line
+: flush-d$-range ( adr len -- )
+ bounds swap /cache-line round-up swap /cache-line round-down ?do
+ i clean-d$-entry i flush-d$-entry
+ /cache-line +loop
+;
+
+\ System-dependent function to flush the entire cache
+\ (In normal ARM nomenclature, as used by most of the words in this file,
+\ "flush" means "invalidate without ensuring that cached data has been
+\ written to memory", while "clean" means "ensure that cached data has been
+\ written to memory". In normal Open Firmware parlance, "invalidate" means
+\ the former and "flush" the latter. "flush-cache" is a generic Open Firmware
+\ operation, so it uses the Open Firmware nomenclature.
+defer flush-cache ' noop to flush-cache
+
+: icache-on ( -- ) flush-i$ control@ h# 1000 or control! ;
+: icache-off ( -- ) control@ h# 1000 invert and control! ;
+: dcache-on ( -- ) flush-d$ control@ 4 or control! ;
+: dcache-off ( -- )
+ control@ dup 4 and if
+ flush-cache
+ 4 invert and control!
+ else
+ drop
+ then
+;
+
+: write-buffer-on ( -- ) control@ 8 or control! ;
+: write-buffer-off ( -- )
+ drain-write-buffer control@ 8 invert and control!
+;
+
+: stand-sync-cache ( adr len -- )
+ cache-bounds ?do i clean-d$-entry /cache-line +loop
+ drain-write-buffer
+ flush-i$
+;
+: stand-init-io ( -- )
+ stand-init-io
+ ['] stand-sync-cache to sync-cache
+;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/scc.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/sqroot.fth
===================================================================
--- cpu/arm/sqroot.fth (rev 0)
+++ cpu/arm/sqroot.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,52 @@
+purpose: Integer square-root for ARM processors
+\ See license at end of file
+
+\ u1 -- 32-bit unsigned
+\ n -- significant digits
+\ 16 -> sqrt-integer
+\ 32 -> fractional integer 16/16bits
+
+code (sqrt \ ( u1 n -- u2 )
+ r0 sp pop
+ r1 0 # mov
+ r2 0 # mov
+ begin r3 r1 mov
+ r0 r0 1 #lsl s mov
+ r2 r2 r2 adc
+ r0 r0 1 #lsl s mov
+ r2 r2 r2 adc
+ r1 r1 2 #lsl mov
+ r1 1 incr
+ r2 r2 r1 s sub \ get C-flag
+ r2 r2 r1 lt add
+ r1 r3 1 #lsl mov
+ r1 r1 1 # ge orr \ bit0 = not-C
+ top 1 s decr
+ eq until
+ top r1 mov c;
+
+: sqrt ( u1 -- u2 ) td 16 (sqrt ;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2008 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/sqroot.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/sync.fth
===================================================================
--- cpu/arm/sync.fth (rev 0)
+++ cpu/arm/sync.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,45 @@
+purpose: Synchronize the caches the hard way (not used if sys-sync-cache works)
+\ See license at end of file
+
+code blow-icache
+ h# 1000 0 do h# ea000006 asm, loop \ b .+32
+c;
+code touch-lines ( adr len -- )
+ pop r0,sp
+ ahead begin
+ ldr r1,[r0]
+ add r0,r0,#32
+ but then
+ subs tos,tos,#32
+ 0<= until
+ pop tos,sp
+c;
+: slow-sync-cache ( adr len -- )
+ 2drop
+ origin h# 8000 touch-lines \ Touch 2x /cache to displace the data cache
+ blow-icache
+;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/sync.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/sys.fth
===================================================================
--- cpu/arm/sys.fth (rev 0)
+++ cpu/arm/sys.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,102 @@
+purpose: Low-level I/O interface for use with a C "wrapper" program.
+\ See license at end of file
+
+\ The C program provides the Forth kernel with an array of entry-points
+\ into C subroutines for performing the actual system calls.
+\ This scheme should be reasonably compatible with nearly any Unix
+\ implementation. The only difference would be in the implementation of
+\ "syscall", which has to look up the address of the actual system call
+\ C routine in the system call table provided to it by the C program loader.
+\ It then has to convert the stack arguments into the same form as is
+\ expected by the C system call routines. This obviously depends on the
+\ details of the C calling sequence, but should not be too hard because
+\ C compilers usually pass arguments on the stack.
+\ Syscall is defined in the kernel, because it is needed for basics like
+\ key and emit.
+
+decimal
+
+/l ualloc-t dup equ syscall-user#
+user syscall-vec \ long address of system call vector
+nuser sysretval
+
+\ I/O for running under an OS with a C program providing actual I/O routines
+
+meta
+code syscall ( call# -- )
+ ldmia sp,{r0,r1,r2,r3,r4,r5} \ Get some arguments
+
+ psh ip,rp \ This register may be clobbered
+ ldr r6,'user syscall-vec \ Get address of system call table
+ add r6,r6,tos \ Call through vector
+ ldr r6,[r6]
+
+ mov lk,pc \ Return address
+ mov pc,r6
+\ ldr pc,[r6,tos] \ Call through vector
+
+ str r0,'user sysretval \ Save the result
+
+ pop ip,rp \ Restore IP
+ pop tos,sp \ Fix stack
+c;
+: retval ( -- return_value ) sysretval l@ ;
+: lretval ( -- l.return_value ) sysretval l@ ;
+
+nuser errno \ The last system error code
+: error? ( return-value -- return-value error? )
+ dup 0< dup if 60 syscall retval errno ! then ( return-value flag )
+;
+
+\ Rounds down to a block boundary. This causes all file accesses to the
+\ underlying operating system to occur on disk block boundaries. Some
+\ systems (e.g. CP/M) require this; others which don't require it
+\ usually run faster with alignment than without.
+
+\ Aligns to a 512-byte boundary
+hex
+: _falign ( l.byte# fd -- l.aligned ) drop 1ff invert and ;
+: _dfalign ( d.byte# fd -- d.aligned ) drop swap 1ff invert and swap ;
+
+: sys-init-io ( -- )
+ install-wrapper-alloc
+ init-relocation
+ install-wrapper-key
+
+ install-disk-io
+ \ Don't poll the keyboard under Unix; block waiting for a key
+ ['] (key ['] key (is
+\ sp@ hex . cr
+\ rp@ hex . cr
+\ origin hex . cr
+\ here hex . cr
+;
+' sys-init-io is init-io
+
+: sys-init ; \ Environment initialization chain
+' sys-init is init-environment
+decimal
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1994 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/sys.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/target.fth
===================================================================
--- cpu/arm/target.fth (rev 0)
+++ cpu/arm/target.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,286 @@
+purpose: Target-dependent definitions for metacompiling the kernel for ARM
+\ See license at end of file
+
+hex
+defer init-relocation-t
+defer set-relocation-bit-t
+
+18000 constant max-kernel \ Maximum size of the kernel
+
+only forth also meta also definitions
+
+
+variable protocol? protocol? off \ true -> information about compiled code
+variable last-protocol
+
+: .data ( n adr -- )
+ push-hex
+ last-protocol @ 0ffffff0 and over 0ffffff0 and <>
+ over d# 12 and 3 * d# 15 + dup >r #out @ < or
+ if cr 0ffffff0 and dup last-protocol ! 9 u.r
+ else drop
+ then
+ r> to-column 8 u.r
+ pop-base
+;
+: .protocol ( c t-adr -- ) protocol? @ if 2dup .data then ;
+
+: lobyte 0ff and ;
+: hibyte 8 >> lobyte ;
+
+ 2 constant /w-t
+ 4 constant /l-t
+ /l-t constant /n-t
+ /l-t constant /a-t
+ /a-t constant /thread-t
+ /l-t constant /token-t
+ /l-t constant /link-t
+/token-t constant /defer-t
+/n-t 800 * constant user-size-t
+/n-t 100 * constant ps-size-t
+/n-t 100 * constant rs-size-t
+/l-t constant /user#-t
+
+\ 32 bit host Forth compiling 32-bit target Forth
+: l->n-t ; immediate
+: n->l-t ; immediate
+: n->n-t ; immediate
+: s->l-t ; immediate
+
+: c!-t ( n adr -- ) >hostaddr c! ;
+: c at -t ( adr -- n ) >hostaddr c@ ;
+\ : w!-t ( n adr -- ) .protocol >hostaddr le-w! ;
+\ : w at -t ( t-adr -- n ) >hostaddr le-w@ ;
+
+: l!-t ( l adr -- ) .protocol >hostaddr le-l! ;
+: l at -t ( t-adr -- l ) >hostaddr le-l@ ;
+
+: !-t ( n adr -- ) l!-t ;
+: @-t ( t-adr -- n ) l at -t ;
+
+\ Store target data types into the host address space.
+: c-t! ( c h-adr -- ) c! ;
+\ : w-t! ( w h-adr -- ) le-w! ;
+: l-t! ( l h-adr -- ) le-l! ;
+: n-t! ( n h-adr -- ) l-t! ;
+
+: c-t@ ( host-address -- c ) c@ ;
+: l-t@ ( host-address -- l ) le-l@ ;
+
+\ Next 3 are machine-independent
+\ Next 3 are machine-independent
+: c,-t ( byte -- ) here-t 1 allot-t c!-t ;
+: w,-t true abort" Called w,-t" ;
+\ : w,-t ( word -- ) here-t /w-t allot-t w!-t ;
+: l,-t ( long -- ) here-t /l-t allot-t l!-t ;
+
+: ,-t ( adr -- ) l,-t ;
+: ,user#-t ( user# -- ) l,-t ;
+
+: a at -t ( t-adr -- t-adr ) l at -t ;
+: a!-t ( token t-adr -- ) set-relocation-bit-t l!-t ;
+: token at -t ( t-adr -- t-adr ) a at -t ;
+: token!-t ( token t-adr -- ) a!-t ;
+
+: rlink at -t ( occurrence -- next-occurrence ) a at -t ;
+: rlink!-t ( next-occurrence occurrence -- ) token!-t ;
+
+
+\ Machine independent
+: a,-t ( adr -- ) here-t /a-t allot-t a!-t ;
+: token,-t ( token -- ) here-t /token-t allot-t token!-t ;
+
+\ These versions of linkx-t are for absolute links
+: link at -t ( t-adr -- t-adr' ) a at -t ;
+: link!-t ( t-adr t-adr -- ) a!-t ;
+: link,-t ( t-adr -- ) a,-t ;
+: a-t@ ( host-address -- target-address )
+[ also forth ]
+ dup origin here within over up@ dup user-size + within or if
+[ previous ]
+ l@
+ else
+ hostaddr> a at -t
+ then
+;
+: a-t! ( target-address host-address -- )
+[ also forth ]
+ dup origin here within over up@ dup user-size + within or if
+[ previous ]
+ l!
+ else
+ hostaddr> a!-t
+ then
+;
+: rlink-t@ ( host-adr -- target-adr ) a-t@ ;
+: rlink-t! ( target-adr host-adr -- ) a-t! ;
+
+: token-t@ ( host-adr -- t-adr ) a-t@ ;
+: token-t! ( t-adr host-adr -- ) a-t! ;
+: link-t@ ( host-adr -- t-adr ) a-t@ ;
+: link-t! ( t-adr host-adr -- ) a-t! ;
+
+\ Machine independent
+: a-t, ( t-adr -- ) here /a-t allot a-t! ;
+: token-t, ( t-adr -- ) here /token-t allot token-t! ;
+: >body-t ( cfa-t -- pfa-t )
+ dup l at -t ff000000 and eb000000 =
+ if /l-t + then ;
+
+1 constant #threads-t \ Must be a power of 2
+create threads-t #threads-t 1+ /link-t * allot
+
+: $hash-t ( adr len voc-ptr -- thread )
+ -rot nip #threads-t 1- and /thread-t * +
+;
+
+\ Should allocate these dynamically.
+\ The dictionary space should be dynamically allocated too.
+
+\ The user area image lives in the host address space.
+\ We wish to store into the user area with -t commands so as not
+\ to need separate words to store target items into host addresses.
+\ That is why user+ returns a target address.
+
+\ Machine Independent
+
+0 constant userarea-t
+: setup-user-area ( -- )
+ here-t is userarea-t
+ user-size-t allot-t
+ userarea-t >hostaddr user-size-t erase ;
+
+: >user-t ( cfa-t -- user-adr-t ) >body-t @-t userarea-t + >hostaddr ;
+: n>link-t ( anf-t -- alf-t ) /link-t - ;
+: l>name-t ( alf-t -- anf-t ) /link-t + ;
+
+decimal
+/l constant #align-t
+/l constant #talign-t
+/l constant #linkalign-t
+/l constant #acf-align-t
+: aligned-t ( n1 -- n2 ) #align-t 1- + #align-t negate and ;
+: acf-aligned-t ( n1 -- n2 ) #acf-align-t 1- + #acf-align-t negate and ;
+
+\ NullFix bl -> 0
+: align-t ( -- )
+ begin here-t #align-t 1- and while 0 c,-t repeat
+;
+: talign-t ( -- )
+ begin here-t #talign-t 1- and while 0 c,-t repeat
+;
+: linkalign-t ( -- )
+ begin here-t #linkalign-t 1- and while 0 c,-t repeat
+;
+: acf-align-t ( -- ) talign-t ;
+
+: entercode ( -- )
+ only forth also labels also meta also arm-assembler
+ [ also arm-assembler also helpers ]
+ ['] $arm-assem-do-undefined is $do-undefined
+ [ previous previous ]
+ align-t
+;
+
+\ Next 5 are Machine Independent
+: cmove-t ( from to-t n -- )
+ 2dup 2>r
+ 0 do over c@ over c!-t ca1+ swap ca1+ swap loop 2drop
+ 2r> protocol? @
+ if base @ >r hex last-protocol off
+ cr ." String at" over 6 u.r space ascii " emit bounds
+ do i c at -t dup bl <
+ if drop else emit then
+ loop ascii " emit r> base !
+ else 2drop
+ then ;
+: place-cstr-t ( adr len cstr-adr-t -- cstr-adr-t )
+ >r tuck r@ swap cmove-t ( len ) r@ + 0 swap c!-t r>
+;
+: "copy-t ( from to-t -- )
+ over c@ 2+ cmove-t ;
+: toggle-t ( addr-t n -- )
+ protocol? @
+ if cr ." Toggle at" base @ >r hex 2dup swap 6 u.r 3 u.r
+ last-protocol off r> base !
+ then
+ swap >r r@ c at -t xor r> c!-t ;
+
+: clear-threads-t ( hostaddr -- )
+ #threads-t /link-t * bounds do
+ origin-t i link-t!
+ /link +loop
+;
+: initmeta ( -- )
+ init-relocation-t
+ threads-t #threads-t /link-t * bounds
+ do origin-t i link-t!
+ threads-t current-t !
+ /link +loop
+ last-protocol on ;
+
+\ For compiling branch offsets/addresses used by control constructs.
+/l-t constant /branch
+
+\rel : branch! ( from to -- ) over - swap l!-t ;
+\rel : branch, ( to -- ) here-t - l,-t ;
+
+\abs : branch! ( from to -- ) swap a!-t ;
+\abs : branch, ( to -- ) a,-t ;
+
+\ Store actions for some data structures. This has to be in this
+\ file because it depends on the location of the user area (in the
+\ ARMx version, the user area is in the dictionary for
+\ relocation to work right, but that is not true for the SPARC
+\ version. Ultimately, separate relocation for the user area is
+\ needed. The relocation probably should be automatic, by looking
+\ at the storage address.
+
+: isuser ( n acf -- ) >user-t n-t! ;
+: istuser ( acf1 acf -- ) >user-t token-t! ;
+: isvalue ( n acf -- ) >user-t n-t! ;
+: isdefer ( acf acf -- ) >user-t token-t! ;
+
+: thread-t! ( thread adr -- ) link!-t ;
+
+
+only forth also meta also definitions
+: install-target-assembler
+ [ assembler also helpers ]
+ ['] allot-t is asm-allot
+ ['] here-t is here
+\ ['] c!-t is byte!
+ ['] l!-t is asm!
+ ['] l at -t is asm@
+ ['] set-relocation-bit-t is asm-set-relocation-bit
+ [ previous previous ]
+;
+: install-host-assembler ( -- )
+\ XXX Just punt for now.
+;
+
+decimal
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2008 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/target.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/testasm.txt
===================================================================
--- cpu/arm/testasm.txt (rev 0)
+++ cpu/arm/testasm.txt 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,1191 @@
+purpose: Test for ARM assembler
+\ See license at end of file
+
+arm-asm helpers
+\ debug amode-lsm
+testloop
+000000 e1a0c00d MOV r12,r13
+000004 e92d000f STMDB r13!,{r0-r3}
+000008 e92ddff0 STMDB r13!,{r4-r12,r14,pc}
+00000c e24cb014 SUB r11,r12,#0x14
+000010 e1a04002 MOV r4,r2
+000014 e2821080 ADD r1,r2,#0x80
+000018 e59b6008 LDR r6,[r11,#8]
+00001c e582107c STR r1,[r2,#0x7c]
+000020 e1a01002 MOV r1,r2
+000028 e3a00000 MOV r0,#0
+00002c e5941008 LDR r1,[r4,#8]
+000030 e2811001 ADD r1,r1,#1
+000034 e2800001 ADD r0,r0,#1
+000038 e3500003 CMP r0,#3
+00003c e5841008 STR r1,[r4,#8]
+000040 bafffff9 BLT 0x2c
+000044 e5940008 LDR r0,[r4,#8]
+000048 e4d01001 LDRB r1,[r0],#1
+00004c e5840008 STR r0,[r4,#8]
+000050 e3a00000 MOV r0,#0
+000054 e5942008 LDR r2,[r4,#8]
+000058 e2822001 ADD r2,r2,#1
+00005c e2800001 ADD r0,r0,#1
+000060 e3500006 CMP r0,#6
+000064 e5842008 STR r2,[r4,#8]
+000068 bafffff9 BLT 0x54
+00006c e3110008 TST r1,#8
+000070 0a000004 BEQ 0x88
+000074 e5941008 LDR r1,[r4,#8]
+000078 e4d10001 LDRB r0,[r1],#1
+00007c e3300000 TEQ r0,#0
+000080 e5841008 STR r1,[r4,#8]
+000084 1afffffa BNE 0x74
+000088 e5941000 LDR r1,[r4,#0]
+00008c e1a02004 MOV r2,r4
+000090 e3a00001 MOV r0,#1
+000098 e2008001 AND r8,r0,#1
+00009c e1a010a0 MOV r1,r0,LSR #1
+0000a0 e5940004 LDR r0,[r4,#4]
+0000a4 e2400001 SUB r0,r0,#1
+0000a8 e5840004 STR r0,[r4,#4]
+0000ac e1a02004 MOV r2,r4
+0000b0 e3a00002 MOV r0,#2
+0000b8 e2101003 ANDS r1,r0,#3
+0000bc e1a02120 MOV r2,r0,LSR #2
+0000c0 e5940004 LDR r0,[r4,#4]
+0000c4 e2400002 SUB r0,r0,#2
+0000c8 e5840004 STR r0,[r4,#4]
+0000cc e5842000 STR r2,[r4,#0]
+0000d0 1a00002a BNE 0x180
+0000d4 e1a01002 MOV r1,r2
+0000d8 e2002007 AND r2,r0,#7
+0000dc e1a01231 MOV r1,r1,LSR r2
+0000e0 e0400002 SUB r0,r0,r2
+0000e4 e5840004 STR r0,[r4,#4]
+0000e8 e1a02004 MOV r2,r4
+0000ec e3a00010 MOV r0,#0x10
+0000f4 e1a05800 MOV r5,r0,LSL #16
+0000f8 e1a05825 MOV r5,r5,LSR #16
+0000fc e1a01820 MOV r1,r0,LSR #16
+000100 e5940004 LDR r0,[r4,#4]
+000104 e2400010 SUB r0,r0,#0x10
+000108 e5840004 STR r0,[r4,#4]
+00010c e1a02004 MOV r2,r4
+000110 e3a00010 MOV r0,#0x10
+000118 e1e01000 MVN r1,r0
+00011c e1a01801 MOV r1,r1,LSL #16
+000120 e1a01821 MOV r1,r1,LSR #16
+000124 e1310005 TEQ r1,r5
+000128 13a08001 MOVNE r8,#1
+00012c 1a0000a5 BNE 0x3c8
+000130 e1a01820 MOV r1,r0,LSR #16
+000134 e5940004 LDR r0,[r4,#4]
+000138 e2400010 SUB r0,r0,#0x10
+00013c e2457001 SUB r7,r5,#1
+000140 e3350000 TEQ r5,#0
+000144 e5840004 STR r0,[r4,#4]
+000148 0a00000a BEQ 0x178
+00014c e1a02004 MOV r2,r4
+000150 e3a00008 MOV r0,#8
+000158 e4c60001 STRB r0,[r6],#1
+00015c e1a01420 MOV r1,r0,LSR #8
+000160 e5940004 LDR r0,[r4,#4]
+000164 e2400008 SUB r0,r0,#8
+000168 e5840004 STR r0,[r4,#4]
+00016c e1b00007 MOVS r0,r7
+000170 e2477001 SUB r7,r7,#1
+000174 1afffff4 BNE 0x14c
+000178 e5841000 STR r1,[r4,#0]
+00017c ea000091 B 0x3c8
+000180 e24ddc05 SUB r13,r13,#0x500
+000184 e3310001 TEQ r1,#1
+000188 e1a03004 MOV r3,r4
+00018c e1a0200d MOV r2,r13
+000190 e28d1e4f ADD r1,r13,#0x4f0
+000194 e92d000e STMDB r13!,{r1-r3}
+000198 e28d3c05 ADD r3,r13,#0x500
+00019c e28d2f41 ADD r2,r13,#0x104
+0001a0 e2822b01 ADD r2,r2,#0x400
+0001a4 e28d1f42 ADD r1,r13,#0x108
+0001a8 e2811b01 ADD r1,r1,#0x400
+0001ac 1a000001 BNE 0x1b8
+0001b4 ea000000 B 0x1bc
+0001bc e28dd00c ADD r13,r13,#0xc
+0001c0 e3300000 TEQ r0,#0
+0001c4 13a08001 MOVNE r8,#1
+0001c8 1a00007d BNE 0x3c4
+0001cc e24dd004 SUB r13,r13,#4
+0001d0 e5941000 LDR r1,[r4,#0]
+0001d4 e3a09001 MOV r9,#1
+0001d8 e59d04f8 LDR r0,[r13,#0x4f8]
+0001dc e1a00019 MOV r0,r9,LSL r0
+0001e0 e240a001 SUB r10,r0,#1
+0001e4 e59d04f4 LDR r0,[r13,#0x4f4]
+0001e8 e1a00019 MOV r0,r9,LSL r0
+0001ec e2400001 SUB r0,r0,#1
+0001f0 e58d0000 STR r0,[r13,#0]
+0001f4 e1a02004 MOV r2,r4
+0001f8 e59d04f8 LDR r0,[r13,#0x4f8]
+000200 e000200a AND r2,r0,r10
+000204 e59d1500 LDR r1,[r13,#0x500]
+000208 e0817182 ADD r7,r1,r2,LSL #3
+00020c e5d75000 LDRB r5,[r7,#0]
+000210 e3550010 CMP r5,#0x10
+000214 9a000013 BLS 0x268
+000218 e3a09001 MOV r9,#1
+00021c e3350063 TEQ r5,#0x63
+000220 0a000066 BEQ 0x3c0
+000224 e5d72001 LDRB r2,[r7,#1]
+000228 e1a01230 MOV r1,r0,LSR r2
+00022c e5940004 LDR r0,[r4,#4]
+000230 e0400002 SUB r0,r0,r2
+000234 e2455010 SUB r5,r5,#0x10
+000238 e5840004 STR r0,[r4,#4]
+00023c e1a02004 MOV r2,r4
+000240 e1a00005 MOV r0,r5
+000248 e1a02519 MOV r2,r9,LSL r5
+00024c e2422001 SUB r2,r2,#1
+000250 e0022000 AND r2,r2,r0
+000254 e5b71004 LDR r1,[r7,#4]!
+000258 e0817182 ADD r7,r1,r2,LSL #3
+00025c e5d75000 LDRB r5,[r7,#0]
+000260 e3550010 CMP r5,#0x10
+000264 8affffec BHI 0x21c
+000268 e5d72001 LDRB r2,[r7,#1]
+00026c e1a01230 MOV r1,r0,LSR r2
+000270 e5940004 LDR r0,[r4,#4]
+000274 e0400002 SUB r0,r0,r2
+000278 e3350010 TEQ r5,#0x10
+00027c e5840004 STR r0,[r4,#4]
+000280 05970004 LDREQ r0,[r7,#4]
+000284 04c60001 STREQB r0,[r6],#1
+000288 0affffd9 BEQ 0x1f4
+00028c e335000f TEQ r5,#0xf
+000290 0a000047 BEQ 0x3b4
+000294 e1a02004 MOV r2,r4
+000298 e1a00005 MOV r0,r5
+0002a0 e5972004 LDR r2,[r7,#4]
+0002a4 e1a02802 MOV r2,r2,LSL #16
+0002a8 e3a01001 MOV r1,#1
+0002ac e1a01511 MOV r1,r1,LSL r5
+0002b0 e2411001 SUB r1,r1,#1
+0002b4 e0011000 AND r1,r1,r0
+0002b8 e0819822 ADD r9,r1,r2,LSR #16
+0002bc e1a01530 MOV r1,r0,LSR r5
+0002c0 e5940004 LDR r0,[r4,#4]
+0002c4 e0400005 SUB r0,r0,r5
+0002c8 e5840004 STR r0,[r4,#4]
+0002cc e1a02004 MOV r2,r4
+0002d0 e59d04f4 LDR r0,[r13,#0x4f4]
+0002d8 e59d1000 LDR r1,[r13,#0]
+0002dc e0001001 AND r1,r0,r1
+0002e0 e59d24fc LDR r2,[r13,#0x4fc]
+0002e4 e0827181 ADD r7,r2,r1,LSL #3
+0002e8 e5d75000 LDRB r5,[r7,#0]
+0002ec e3550010 CMP r5,#0x10
+0002f0 9a000013 BLS 0x344
+0002f4 e3350063 TEQ r5,#0x63
+0002f8 0a000030 BEQ 0x3c0
+0002fc e5d72001 LDRB r2,[r7,#1]
+000300 e1a01230 MOV r1,r0,LSR r2
+000304 e5940004 LDR r0,[r4,#4]
+000308 e0400002 SUB r0,r0,r2
+00030c e2455010 SUB r5,r5,#0x10
+000310 e5840004 STR r0,[r4,#4]
+000314 e1a02004 MOV r2,r4
+000318 e1a00005 MOV r0,r5
+000320 e3a02001 MOV r2,#1
+000324 e1a02512 MOV r2,r2,LSL r5
+000328 e2422001 SUB r2,r2,#1
+00032c e0022000 AND r2,r2,r0
+000330 e5b71004 LDR r1,[r7,#4]!
+000334 e0817182 ADD r7,r1,r2,LSL #3
+000338 e5d75000 LDRB r5,[r7,#0]
+00033c e3550010 CMP r5,#0x10
+000340 8affffeb BHI 0x2f4
+000344 e5d72001 LDRB r2,[r7,#1]
+000348 e1a01230 MOV r1,r0,LSR r2
+00034c e5940004 LDR r0,[r4,#4]
+000350 e0400002 SUB r0,r0,r2
+000354 e5840004 STR r0,[r4,#4]
+000358 e1a02004 MOV r2,r4
+00035c e1a00005 MOV r0,r5
+000364 e5971004 LDR r1,[r7,#4]
+000368 e1a01801 MOV r1,r1,LSL #16
+00036c e3a02001 MOV r2,#1
+000370 e1a02512 MOV r2,r2,LSL r5
+000374 e2422001 SUB r2,r2,#1
+000378 e0022000 AND r2,r2,r0
+00037c e0822821 ADD r2,r2,r1,LSR #16
+000380 e1a01530 MOV r1,r0,LSR r5
+000384 e5940004 LDR r0,[r4,#4]
+000388 e0400005 SUB r0,r0,r5
+00038c e5840004 STR r0,[r4,#4]
+000390 e2490001 SUB r0,r9,#1
+000394 e3390000 TEQ r9,#0
+000398 0affff95 BEQ 0x1f4
+00039c e7563002 LDRB r3,[r6,-r2]
+0003a0 e4c63001 STRB r3,[r6],#1
+0003a4 e1b03000 MOVS r3,r0
+0003a8 e2400001 SUB r0,r0,#1
+0003ac 1afffffa BNE 0x39c
+0003b0 eaffff8f B 0x1f4
+0003b4 e5940020 LDR r0,[r4,#0x20]
+0003b8 e584007c STR r0,[r4,#0x7c]
+0003bc e5841000 STR r1,[r4,#0]
+0003c0 e28dd004 ADD r13,r13,#4
+0003c4 e28ddc05 ADD r13,r13,#0x500
+0003c8 e3380000 TEQ r8,#0
+0003cc 0affff2d BEQ 0x88
+0003d0 e59b1008 LDR r1,[r11,#8]
+0003d4 e0460001 SUB r0,r6,r1
+0003d8 e91baff0 LDMDB r11,{r4-r11,r13,pc}
+0003dc e92d47f0 STMDB r13!,{r4-r10,r14}
+0003e0 e3a02000 MOV r2,#0
+0003e4 e5812000 STR r2,[r1,#0]
+0003e8 e5810008 STR r0,[r1,#8]
+0003ec e5812004 STR r2,[r1,#4]
+0003f0 e591007c LDR r0,[r1,#0x7c]
+0003f4 e581000c STR r0,[r1,#0xc]
+0003f8 e591007c LDR r0,[r1,#0x7c]
+0003fc e280004c ADD r0,r0,#0x4c
+000400 e581007c STR r0,[r1,#0x7c]
+000404 e3a09010 MOV r9,#0x10
+000408 e591000c LDR r0,[r1,#0xc]
+00040c e3a05011 MOV r5,#0x11
+000410 e3a03012 MOV r3,#0x12
+000414 e4809004 STR r9,[r0],#4
+000418 e4805004 STR r5,[r0],#4
+00041c e4803004 STR r3,[r0],#4
+000420 e5802000 STR r2,[r0,#0]
+000424 e2806004 ADD r6,r0,#4
+000428 e3a04008 MOV r4,#8
+00042c e3a0e007 MOV r14,#7
+000430 e3a0c009 MOV r12,#9
+000434 e3a03006 MOV r3,#6
+000438 e3a0800a MOV r8,#0xa
+00043c e3a00005 MOV r0,#5
+000440 e3a0700b MOV r7,#0xb
+000444 e3a0a004 MOV r10,#4
+000448 e8a64010 STMIA r6!,{r4,r14}
+00044c e486c004 STR r12,[r6],#4
+000450 e8a60108 STMIA r6!,{r3,r8}
+000454 e8a60481 STMIA r6!,{r0,r7,r10}
+000458 e3a0a00c MOV r10,#0xc
+00045c e486a004 STR r10,[r6],#4
+000460 e3a0a003 MOV r10,#3
+000464 e486a004 STR r10,[r6],#4
+000468 e3a0a00d MOV r10,#0xd
+00046c e486a004 STR r10,[r6],#4
+000470 e3a0a002 MOV r10,#2
+000474 e486a004 STR r10,[r6],#4
+000478 e3a0a00e MOV r10,#0xe
+00047c e486a004 STR r10,[r6],#4
+000480 e3a0a001 MOV r10,#1
+000484 e486a004 STR r10,[r6],#4
+000488 e3a0a00f MOV r10,#0xf
+00048c e586a000 STR r10,[r6,#0]
+000490 e591607c LDR r6,[r1,#0x7c]
+000494 e5816010 STR r6,[r1,#0x10]
+000498 e591607c LDR r6,[r1,#0x7c]
+00049c e2866040 ADD r6,r6,#0x40
+0004a0 e581607c STR r6,[r1,#0x7c]
+0004a4 e3a0a003 MOV r10,#3
+0004a8 e5916010 LDR r6,[r1,#0x10]
+0004ac e5c6a000 STRB r10,[r6,#0]
+0004b0 e5c62001 STRB r2,[r6,#1]
+0004b4 e3a0a004 MOV r10,#4
+0004b8 e5e6a002 STRB r10,[r6,#2]!
+0004bc e5c62001 STRB r2,[r6,#1]
+0004c0 e5e60002 STRB r0,[r6,#2]!
+0004c4 e5c62001 STRB r2,[r6,#1]
+0004c8 e5e63002 STRB r3,[r6,#2]!
+0004cc e5c62001 STRB r2,[r6,#1]
+0004d0 e5e6e002 STRB r14,[r6,#2]!
+0004d4 e5c62001 STRB r2,[r6,#1]
+0004d8 e5e64002 STRB r4,[r6,#2]!
+0004dc e5c62001 STRB r2,[r6,#1]
+0004e0 e5e6c002 STRB r12,[r6,#2]!
+0004e4 e5c62001 STRB r2,[r6,#1]
+0004e8 e5e68002 STRB r8,[r6,#2]!
+0004ec e5c62001 STRB r2,[r6,#1]
+0004f0 e5e67002 STRB r7,[r6,#2]!
+0004f4 e5c62001 STRB r2,[r6,#1]
+0004f8 e3a0a00d MOV r10,#0xd
+0004fc e5e6a002 STRB r10,[r6,#2]!
+000500 e5c62001 STRB r2,[r6,#1]
+000504 e3a0a00f MOV r10,#0xf
+000508 e5e6a002 STRB r10,[r6,#2]!
+00050c e5c62001 STRB r2,[r6,#1]
+000510 e5e65002 STRB r5,[r6,#2]!
+000514 e5c62001 STRB r2,[r6,#1]
+000518 e3a07013 MOV r7,#0x13
+00051c e5e67002 STRB r7,[r6,#2]!
+000520 e5c62001 STRB r2,[r6,#1]
+000524 e3a07017 MOV r7,#0x17
+000528 e5e67002 STRB r7,[r6,#2]!
+00052c e5c62001 STRB r2,[r6,#1]
+000530 e3a0701b MOV r7,#0x1b
+000534 e5e67002 STRB r7,[r6,#2]!
+000538 e5c62001 STRB r2,[r6,#1]
+00053c e3a0701f MOV r7,#0x1f
+000540 e5e67002 STRB r7,[r6,#2]!
+000544 e5c62001 STRB r2,[r6,#1]
+000548 e3a07023 MOV r7,#0x23
+00054c e5e67002 STRB r7,[r6,#2]!
+000550 e5c62001 STRB r2,[r6,#1]
+000554 e3a0702b MOV r7,#0x2b
+000558 e5e67002 STRB r7,[r6,#2]!
+00055c e5c62001 STRB r2,[r6,#1]
+000560 e3a07033 MOV r7,#0x33
+000564 e5e67002 STRB r7,[r6,#2]!
+000568 e5c62001 STRB r2,[r6,#1]
+00056c e3a0703b MOV r7,#0x3b
+000570 e5e67002 STRB r7,[r6,#2]!
+000574 e5c62001 STRB r2,[r6,#1]
+000578 e3a08043 MOV r8,#0x43
+00057c e5e68002 STRB r8,[r6,#2]!
+000580 e5c62001 STRB r2,[r6,#1]
+000584 e2867002 ADD r7,r6,#2
+000588 e3a06053 MOV r6,#0x53
+00058c e5c76000 STRB r6,[r7,#0]
+000590 e5c72001 STRB r2,[r7,#1]
+000594 e3a06063 MOV r6,#0x63
+000598 e5e76002 STRB r6,[r7,#2]!
+00059c e5c72001 STRB r2,[r7,#1]
+0005a0 e3a08073 MOV r8,#0x73
+0005a4 e5e78002 STRB r8,[r7,#2]!
+0005a8 e5c72001 STRB r2,[r7,#1]
+0005ac e3a08083 MOV r8,#0x83
+0005b0 e5e78002 STRB r8,[r7,#2]!
+0005b4 e5c72001 STRB r2,[r7,#1]
+0005b8 e3a080a3 MOV r8,#0xa3
+0005bc e5e78002 STRB r8,[r7,#2]!
+0005c0 e5c72001 STRB r2,[r7,#1]
+0005c4 e3a080c3 MOV r8,#0xc3
+0005c8 e5e78002 STRB r8,[r7,#2]!
+0005cc e5c72001 STRB r2,[r7,#1]
+0005d0 e3a080e3 MOV r8,#0xe3
+0005d4 e5e78002 STRB r8,[r7,#2]!
+0005d8 e5c72001 STRB r2,[r7,#1]
+0005dc e2877002 ADD r7,r7,#2
+0005e0 e3a08002 MOV r8,#2
+0005e4 e5c78000 STRB r8,[r7,#0]
+0005e8 e3a0a001 MOV r10,#1
+0005ec e5c7a001 STRB r10,[r7,#1]
+0005f0 e7e72008 STRB r2,[r7,r8]!
+0005f4 e5c72001 STRB r2,[r7,#1]
+0005f8 e7e72008 STRB r2,[r7,r8]!
+0005fc e5c72001 STRB r2,[r7,#1]
+000600 e591707c LDR r7,[r1,#0x7c]
+000604 e5817014 STR r7,[r1,#0x14]
+000608 e591707c LDR r7,[r1,#0x7c]
+00060c e2877040 ADD r7,r7,#0x40
+000610 e581707c STR r7,[r1,#0x7c]
+000614 e3a07000 MOV r7,#0
+000618 e591a014 LDR r10,[r1,#0x14]
+00061c e3a02000 MOV r2,#0
+000620 e5ca2000 STRB r2,[r10,#0]
+000624 e5ca2001 STRB r2,[r10,#1]
+000628 e28aa002 ADD r10,r10,#2
+00062c e2877001 ADD r7,r7,#1
+000630 e3570004 CMP r7,#4
+000634 bafffff8 BLT 0x61c
+000638 e357001c CMP r7,#0x1c
+00063c aa000012 BGE 0x68c
+000640 e2572001 SUBS r2,r7,#1
+000644 42822003 ADDMI r2,r2,#3
+000648 e1a02142 MOV r2,r2,ASR #2
+00064c e1a08802 MOV r8,r2,LSL #16
+000650 e1a08828 MOV r8,r8,LSR #16
+000654 e1a0200a MOV r2,r10
+000658 e5ca8000 STRB r8,[r10,#0]
+00065c e1a0a448 MOV r10,r8,ASR #8
+000660 e5c2a001 STRB r10,[r2,#1]
+000664 e5e28002 STRB r8,[r2,#2]!
+000668 e5c2a001 STRB r10,[r2,#1]
+00066c e5e28002 STRB r8,[r2,#2]!
+000670 e5c2a001 STRB r10,[r2,#1]
+000674 e5e28002 STRB r8,[r2,#2]!
+000678 e5c2a001 STRB r10,[r2,#1]
+00067c e282a002 ADD r10,r2,#2
+000680 e2877004 ADD r7,r7,#4
+000684 e357001c CMP r7,#0x1c
+000688 baffffec BLT 0x640
+00068c e3a02000 MOV r2,#0
+000690 e5ca2000 STRB r2,[r10,#0]
+000694 e5ca2001 STRB r2,[r10,#1]
+000698 e5ea6002 STRB r6,[r10,#2]!
+00069c e5ca2001 STRB r2,[r10,#1]
+0006a0 e5ea6002 STRB r6,[r10,#2]!
+0006a4 e5ca2001 STRB r2,[r10,#1]
+0006a8 e591607c LDR r6,[r1,#0x7c]
+0006ac e5816018 STR r6,[r1,#0x18]
+0006b0 e2867040 ADD r7,r6,#0x40
+0006b4 e581707c STR r7,[r1,#0x7c]
+0006b8 e3a07001 MOV r7,#1
+0006bc e5c67000 STRB r7,[r6,#0]
+0006c0 e5c62001 STRB r2,[r6,#1]
+0006c4 e3a0a002 MOV r10,#2
+0006c8 e5e6a002 STRB r10,[r6,#2]!
+0006cc e5c62001 STRB r2,[r6,#1]
+0006d0 e3a08003 MOV r8,#3
+0006d4 e7e6800a STRB r8,[r6,r10]!
+0006d8 e5c62001 STRB r2,[r6,#1]
+0006dc e3a08004 MOV r8,#4
+0006e0 e7e6800a STRB r8,[r6,r10]!
+0006e4 e5c62001 STRB r2,[r6,#1]
+0006e8 e5e60002 STRB r0,[r6,#2]!
+0006ec e5c62001 STRB r2,[r6,#1]
+0006f0 e5e6e002 STRB r14,[r6,#2]!
+0006f4 e5c62001 STRB r2,[r6,#1]
+0006f8 e5e6c002 STRB r12,[r6,#2]!
+0006fc e5c62001 STRB r2,[r6,#1]
+000700 e3a0000d MOV r0,#0xd
+000704 e5e60002 STRB r0,[r6,#2]!
+000708 e5c62001 STRB r2,[r6,#1]
+00070c e5e65002 STRB r5,[r6,#2]!
+000710 e5c62001 STRB r2,[r6,#1]
+000714 e2860002 ADD r0,r6,#2
+000718 e3a0c019 MOV r12,#0x19
+00071c e5c0c000 STRB r12,[r0,#0]
+000720 e5c02001 STRB r2,[r0,#1]
+000724 e3a0c021 MOV r12,#0x21
+000728 e5e0c002 STRB r12,[r0,#2]!
+00072c e5c02001 STRB r2,[r0,#1]
+000730 e3a0c031 MOV r12,#0x31
+000734 e5e0c002 STRB r12,[r0,#2]!
+000738 e5c02001 STRB r2,[r0,#1]
+00073c e3a0c041 MOV r12,#0x41
+000740 e5e0c002 STRB r12,[r0,#2]!
+000744 e5c02001 STRB r2,[r0,#1]
+000748 e3a0c061 MOV r12,#0x61
+00074c e5e0c002 STRB r12,[r0,#2]!
+000750 e5c02001 STRB r2,[r0,#1]
+000754 e3a0c081 MOV r12,#0x81
+000758 e5e0c002 STRB r12,[r0,#2]!
+00075c e5c02001 STRB r2,[r0,#1]
+000760 e3a0c0c1 MOV r12,#0xc1
+000764 e5e0c002 STRB r12,[r0,#2]!
+000768 e5c02001 STRB r2,[r0,#1]
+00076c e2800002 ADD r0,r0,#2
+000770 e3a0c001 MOV r12,#1
+000774 e5c0c000 STRB r12,[r0,#0]
+000778 e5c07001 STRB r7,[r0,#1]
+00077c e2800002 ADD r0,r0,#2
+000780 e3a0c081 MOV r12,#0x81
+000784 e5c0c000 STRB r12,[r0,#0]
+000788 e5c07001 STRB r7,[r0,#1]
+00078c e2800002 ADD r0,r0,#2
+000790 e3a0c001 MOV r12,#1
+000794 e5c0c000 STRB r12,[r0,#0]
+000798 e5c0a001 STRB r10,[r0,#1]
+00079c e2800002 ADD r0,r0,#2
+0007a0 e5c0c000 STRB r12,[r0,#0]
+0007a4 e3a08003 MOV r8,#3
+0007a8 e5c08001 STRB r8,[r0,#1]
+0007ac e2800002 ADD r0,r0,#2
+0007b0 e5c0c000 STRB r12,[r0,#0]
+0007b4 e3a08004 MOV r8,#4
+0007b8 e5c08001 STRB r8,[r0,#1]
+0007bc e2800002 ADD r0,r0,#2
+0007c0 e3a0c001 MOV r12,#1
+0007c4 e5c0c000 STRB r12,[r0,#0]
+0007c8 e5c03001 STRB r3,[r0,#1]
+0007cc e2800002 ADD r0,r0,#2
+0007d0 e3a03001 MOV r3,#1
+0007d4 e5c03000 STRB r3,[r0,#0]
+0007d8 e5c04001 STRB r4,[r0,#1]
+0007dc e2800002 ADD r0,r0,#2
+0007e0 e5c03000 STRB r3,[r0,#0]
+0007e4 e3a0a00c MOV r10,#0xc
+0007e8 e5c0a001 STRB r10,[r0,#1]
+0007ec e2800002 ADD r0,r0,#2
+0007f0 e5c03000 STRB r3,[r0,#0]
+0007f4 e5c09001 STRB r9,[r0,#1]
+0007f8 e2800002 ADD r0,r0,#2
+0007fc e3a03001 MOV r3,#1
+000800 e5c03000 STRB r3,[r0,#0]
+000804 e3a03018 MOV r3,#0x18
+000808 e5c03001 STRB r3,[r0,#1]
+00080c e2800002 ADD r0,r0,#2
+000810 e3a03001 MOV r3,#1
+000814 e5c03000 STRB r3,[r0,#0]
+000818 e3a03020 MOV r3,#0x20
+00081c e5c03001 STRB r3,[r0,#1]
+000820 e2800002 ADD r0,r0,#2
+000824 e3a03001 MOV r3,#1
+000828 e5c03000 STRB r3,[r0,#0]
+00082c e3a03030 MOV r3,#0x30
+000830 e5c03001 STRB r3,[r0,#1]
+000834 e2800002 ADD r0,r0,#2
+000838 e3a03001 MOV r3,#1
+00083c e5c03000 STRB r3,[r0,#0]
+000840 e3a03040 MOV r3,#0x40
+000844 e5c03001 STRB r3,[r0,#1]
+000848 e2800002 ADD r0,r0,#2
+00084c e3a03001 MOV r3,#1
+000850 e5c03000 STRB r3,[r0,#0]
+000854 e3a03060 MOV r3,#0x60
+000858 e5c03001 STRB r3,[r0,#1]
+00085c e591007c LDR r0,[r1,#0x7c]
+000860 e581001c STR r0,[r1,#0x1c]
+000864 e1a03000 MOV r3,r0
+000868 e2800040 ADD r0,r0,#0x40
+00086c e581007c STR r0,[r1,#0x7c]
+000870 e5c32000 STRB r2,[r3,#0]
+000874 e5c32001 STRB r2,[r3,#1]
+000878 e5e32002 STRB r2,[r3,#2]!
+00087c e5c32001 STRB r2,[r3,#1]
+000880 e2833002 ADD r3,r3,#2
+000884 e3a00002 MOV r0,#2
+000888 e2402001 SUB r2,r0,#1
+00088c e0822fa2 ADD r2,r2,r2,LSR #31
+000890 e1a020c2 MOV r2,r2,ASR #1
+000894 e1a0c802 MOV r12,r2,LSL #16
+000898 e1a0c82c MOV r12,r12,LSR #16
+00089c e5c3c000 STRB r12,[r3,#0]
+0008a0 e1a0242c MOV r2,r12,LSR #8
+0008a4 e5c32001 STRB r2,[r3,#1]
+0008a8 e5e3c002 STRB r12,[r3,#2]!
+0008ac e5c32001 STRB r2,[r3,#1]
+0008b0 e2833002 ADD r3,r3,#2
+0008b4 e2800002 ADD r0,r0,#2
+0008b8 e350001e CMP r0,#0x1e
+0008bc bafffff1 BLT 0x888
+0008c0 e591007c LDR r0,[r1,#0x7c]
+0008c4 e5a10020 STR r0,[r1,#0x20]!
+0008c8 e8bd87f0 LDMIA r13!,{r4-r10,pc}
+0008cc e5923004 LDR r3,[r2,#4]
+0008d0 e1530000 CMP r3,r0
+0008d4 2a000008 BCS 0x8fc
+0008d8 e5923008 LDR r3,[r2,#8]
+0008dc e4d3c001 LDRB r12,[r3],#1
+0008e0 e5823008 STR r3,[r2,#8]
+0008e4 e5923004 LDR r3,[r2,#4]
+0008e8 e181131c ORR r1,r1,r12,LSL r3
+0008ec e2833008 ADD r3,r3,#8
+0008f0 e5823004 STR r3,[r2,#4]
+0008f4 e1530000 CMP r3,r0
+0008f8 3afffff6 BCC 0x8d8
+0008fc e1a00001 MOV r0,r1
+000900 e1a0f00e MOV pc,r14
+000904 e1a0c00d MOV r12,r13
+000908 e92d000f STMDB r13!,{r0-r3}
+00090c e92ddff0 STMDB r13!,{r4-r12,r14,pc}
+000910 e24cb014 SUB r11,r12,#0x14
+000914 e59b301c LDR r3,[r11,#0x1c]
+000918 e24ddf5b SUB r13,r13,#0x16c
+00091c e24ddb01 SUB r13,r13,#0x400
+000920 e3a02000 MOV r2,#0
+000924 e3a0c000 MOV r12,#0
+000928 e28def46 ADD r14,r13,#0x118
+00092c e28eeb01 ADD r14,r14,#0x400
+000930 e78ec102 STR r12,[r14,r2,LSL #2]
+000934 e2822001 ADD r2,r2,#1
+000938 e3520011 CMP r2,#0x11
+00093c 3afffff9 BCC 0x928
+000940 e1a02000 MOV r2,r0
+000944 e1a0e001 MOV r14,r1
+000948 e28d5f46 ADD r5,r13,#0x118
+00094c e2855b01 ADD r5,r5,#0x400
+000950 e4924004 LDR r4,[r2],#4
+000954 e0854104 ADD r4,r5,r4,LSL #2
+000958 e5945000 LDR r5,[r4,#0]
+00095c e2855001 ADD r5,r5,#1
+000960 e25ee001 SUBS r14,r14,#1
+000964 e5845000 STR r5,[r4,#0]
+000968 1afffff6 BNE 0x948
+00096c e59d2518 LDR r2,[r13,#0x518]
+000970 e1320001 TEQ r2,r1
+000974 1a000004 BNE 0x98c
+000978 e1a0000c MOV r0,r12
+00097c e59bc018 LDR r12,[r11,#0x18]
+000980 e58c0000 STR r0,[r12,#0]
+000984 e5830000 STR r0,[r3,#0]
+000988 ea000107 B 0xdac
+00098c e3a04001 MOV r4,#1
+000990 e5932000 LDR r2,[r3,#0]
+000994 e28def46 ADD r14,r13,#0x118
+000998 e28eeb01 ADD r14,r14,#0x400
+00099c e79ee104 LDR r14,[r14,r4,LSL #2]
+0009a0 e33e0000 TEQ r14,#0
+0009a4 1a000002 BNE 0x9b4
+0009a8 e2844001 ADD r4,r4,#1
+0009ac e3540010 CMP r4,#0x10
+0009b0 9afffff7 BLS 0x994
+0009b4 e1a05004 MOV r5,r4
+0009b8 e1520004 CMP r2,r4
+0009bc 31a02004 MOVCC r2,r4
+0009c0 e3a0e010 MOV r14,#0x10
+0009c4 e28d6f46 ADD r6,r13,#0x118
+0009c8 e2866b01 ADD r6,r6,#0x400
+0009cc e796610e LDR r6,[r6,r14,LSL #2]
+0009d0 e3360000 TEQ r6,#0
+0009d4 1a000001 BNE 0x9e0
+0009d8 e25ee001 SUBS r14,r14,#1
+0009dc 1afffff8 BNE 0x9c4
+0009e0 e58de510 STR r14,[r13,#0x510]
+0009e4 e152000e CMP r2,r14
+0009e8 81a0200e MOVHI r2,r14
+0009ec e5832000 STR r2,[r3,#0]
+0009f0 e3a03001 MOV r3,#1
+0009f4 e1a07413 MOV r7,r3,LSL r4
+0009f8 e3a06002 MOV r6,#2
+0009fc e154000e CMP r4,r14
+000a00 2a00000a BCS 0xa30
+000a04 e28d8f46 ADD r8,r13,#0x118
+000a08 e2888b01 ADD r8,r8,#0x400
+000a0c e7988104 LDR r8,[r8,r4,LSL #2]
+000a10 e0577008 SUBS r7,r7,r8
+000a14 5a000001 BPL 0xa20
+000a18 e1a00006 MOV r0,r6
+000a1c ea0000e2 B 0xdac
+000a20 e2844001 ADD r4,r4,#1
+000a24 e1a07087 MOV r7,r7,LSL #1
+000a28 e154000e CMP r4,r14
+000a2c 3afffff4 BCC 0xa04
+000a30 e28d4f46 ADD r4,r13,#0x118
+000a34 e2844b01 ADD r4,r4,#0x400
+000a38 e794410e LDR r4,[r4,r14,LSL #2]
+000a3c e0577004 SUBS r7,r7,r4
+000a40 e58d7000 STR r7,[r13,#0]
+000a44 4afffff3 BMI 0xa18
+000a48 e59d7000 LDR r7,[r13,#0]
+000a4c e0846007 ADD r6,r4,r7
+000a50 e28d4f46 ADD r4,r13,#0x118
+000a54 e2844b01 ADD r4,r4,#0x400
+000a58 e784610e STR r6,[r4,r14,LSL #2]
+000a5c e3a04000 MOV r4,#0
+000a60 e58d4008 STR r4,[r13,#8]
+000a64 e28d6f47 ADD r6,r13,#0x11c
+000a68 e2866b01 ADD r6,r6,#0x400
+000a6c e28d700c ADD r7,r13,#0xc
+000a70 e25ee001 SUBS r14,r14,#1
+000a74 0a000004 BEQ 0xa8c
+000a78 e4968004 LDR r8,[r6],#4
+000a7c e0884004 ADD r4,r8,r4
+000a80 e25ee001 SUBS r14,r14,#1
+000a84 e4874004 STR r4,[r7],#4
+000a88 1afffffa BNE 0xa78
+000a8c e1a04000 MOV r4,r0
+000a90 e4940004 LDR r0,[r4],#4
+000a94 e3300000 TEQ r0,#0
+000a98 0a000006 BEQ 0xab8
+000a9c e28d6004 ADD r6,r13,#4
+000aa0 e7968100 LDR r8,[r6,r0,LSL #2]
+000aa4 e2887001 ADD r7,r8,#1
+000aa8 e28d6004 ADD r6,r13,#4
+000aac e7867100 STR r7,[r6,r0,LSL #2]
+000ab0 e28d0048 ADD r0,r13,#0x48
+000ab4 e780e108 STR r14,[r0,r8,LSL #2]
+000ab8 e28ee001 ADD r14,r14,#1
+000abc e15e0001 CMP r14,r1
+000ac0 3afffff2 BCC 0xa90
+000ac4 e3a0e000 MOV r14,#0
+000ac8 e58de004 STR r14,[r13,#4]
+000acc e28d6048 ADD r6,r13,#0x48
+000ad0 e3e04000 MVN r4,#0
+000ad4 e2620000 RSB r0,r2,#0
+000ad8 e3a08000 MOV r8,#0
+000adc e3a07000 MOV r7,#0
+000ae0 e58dc4c8 STR r12,[r13,#0x4c8]
+000ae4 e59d9510 LDR r9,[r13,#0x510]
+000ae8 e1550009 CMP r5,r9
+000aec ca0000a8 BGT 0xd94
+000af0 e28dc048 ADD r12,r13,#0x48
+000af4 e08c1101 ADD r1,r12,r1,LSL #2
+000af8 e58d1568 STR r1,[r13,#0x568]
+000afc e28d1f46 ADD r1,r13,#0x118
+000b00 e2811b01 ADD r1,r1,#0x400
+000b04 e7911105 LDR r1,[r1,r5,LSL #2]
+000b08 e2413001 SUB r3,r1,#1
+000b0c e3310000 TEQ r1,#0
+000b10 e58d355c STR r3,[r13,#0x55c]
+000b14 0a00009a BEQ 0xd84
+000b18 e28d3f46 ADD r3,r13,#0x118
+000b1c e2833b01 ADD r3,r3,#0x400
+000b20 e083c105 ADD r12,r3,r5,LSL #2
+000b24 e2451001 SUB r1,r5,#1
+000b28 e3a03001 MOV r3,#1
+000b2c e1a01113 MOV r1,r3,LSL r1
+000b30 e58d1560 STR r1,[r13,#0x560]
+000b34 e58dc564 STR r12,[r13,#0x564]
+000b38 e0801002 ADD r1,r0,r2
+000b3c e1510005 CMP r1,r5
+000b40 aa000041 BGE 0xc4c
+000b44 e59d155c LDR r1,[r13,#0x55c]
+000b48 e2811001 ADD r1,r1,#1
+000b4c e2844001 ADD r4,r4,#1
+000b50 e0800002 ADD r0,r0,r2
+000b54 e59d3510 LDR r3,[r13,#0x510]
+000b58 e0433000 SUB r3,r3,r0
+000b5c e1530002 CMP r3,r2
+000b60 91a07003 MOVLS r7,r3
+000b64 81a07002 MOVHI r7,r2
+000b68 e0453000 SUB r3,r5,r0
+000b6c e3a0a001 MOV r10,#1
+000b70 e1a0c31a MOV r12,r10,LSL r3
+000b74 e15c0001 CMP r12,r1
+000b78 9a00000c BLS 0xbb0
+000b7c e04c8001 SUB r8,r12,r1
+000b80 e2833001 ADD r3,r3,#1
+000b84 e1530007 CMP r3,r7
+000b88 e59dc564 LDR r12,[r13,#0x564]
+000b8c 2a000007 BCS 0xbb0
+000b90 e1a09088 MOV r9,r8,LSL #1
+000b94 e5bc8004 LDR r8,[r12,#4]!
+000b98 e1590008 CMP r9,r8
+000b9c 9a000003 BLS 0xbb0
+000ba0 e0498008 SUB r8,r9,r8
+000ba4 e2833001 ADD r3,r3,#1
+000ba8 e1530007 CMP r3,r7
+000bac 3afffff7 BCC 0xb90
+000bb0 e1a0731a MOV r7,r10,LSL r3
+000bb4 e59b9020 LDR r9,[r11,#0x20]
+000bb8 e5b9c07c LDR r12,[r9,#0x7c]!
+000bbc e08c8187 ADD r8,r12,r7,LSL #3
+000bc0 e2888008 ADD r8,r8,#8
+000bc4 e59b9020 LDR r9,[r11,#0x20]
+000bc8 e5a9807c STR r8,[r9,#0x7c]!
+000bcc e28c8008 ADD r8,r12,#8
+000bd0 e59b9018 LDR r9,[r11,#0x18]
+000bd4 e5898000 STR r8,[r9,#0]
+000bd8 e3a09000 MOV r9,#0
+000bdc e28cc004 ADD r12,r12,#4
+000be0 e58bc018 STR r12,[r11,#0x18]
+000be4 e58c9000 STR r9,[r12,#0]
+000be8 e28dc0c8 ADD r12,r13,#0xc8
+000bec e28ccb01 ADD r12,r12,#0x400
+000bf0 e78c8104 STR r8,[r12,r4,LSL #2]
+000bf4 e3340000 TEQ r4,#0
+000bf8 0a000010 BEQ 0xc40
+000bfc e28dc004 ADD r12,r13,#4
+000c00 e78ce104 STR r14,[r12,r4,LSL #2]
+000c04 e5cd2509 STRB r2,[r13,#0x509]
+000c08 e2833010 ADD r3,r3,#0x10
+000c0c e5cd3508 STRB r3,[r13,#0x508]
+000c10 e0403002 SUB r3,r0,r2
+000c14 e1a0333e MOV r3,r14,LSR r3
+000c18 e58d850c STR r8,[r13,#0x50c]
+000c1c e28dc0c8 ADD r12,r13,#0xc8
+000c20 e28ccb01 ADD r12,r12,#0x400
+000c24 e08cc104 ADD r12,r12,r4,LSL #2
+000c28 e51cc004 LDR r12,[r12,#-4]
+000c2c e08c9183 ADD r9,r12,r3,LSL #3
+000c30 e28daf42 ADD r10,r13,#0x108
+000c34 e28aab01 ADD r10,r10,#0x400
+000c38 e89a1008 LDMIA r10,{r3,r12}
+000c3c e8891008 STMIA r9,{r3,r12}
+000c40 e0803002 ADD r3,r0,r2
+000c44 e1530005 CMP r3,r5
+000c48 baffffbf BLT 0xb4c
+000c4c e0453000 SUB r3,r5,r0
+000c50 e5cd3509 STRB r3,[r13,#0x509]
+000c54 e59d1568 LDR r1,[r13,#0x568]
+000c58 e1510006 CMP r1,r6
+000c5c 93a01063 MOVLS r1,#0x63
+000c60 95cd1508 STRLSB r1,[r13,#0x508]
+000c64 9a000019 BLS 0xcd0
+000c68 e5961000 LDR r1,[r6,#0]
+000c6c e59bc00c LDR r12,[r11,#0xc]
+000c70 e151000c CMP r1,r12
+000c74 2a000008 BCS 0xc9c
+000c78 e3510c01 CMP r1,#0x100
+000c7c 23a0100f MOVCS r1,#0xf
+000c80 33a01010 MOVCC r1,#0x10
+000c84 e5cd1508 STRB r1,[r13,#0x508]
+000c88 e4961004 LDR r1,[r6],#4
+000c8c e5cd150c STRB r1,[r13,#0x50c]
+000c90 e1a01441 MOV r1,r1,ASR #8
+000c94 e5cd150d STRB r1,[r13,#0x50d]
+000c98 ea00000c B 0xcd0
+000c9c e59bc00c LDR r12,[r11,#0xc]
+000ca0 e041100c SUB r1,r1,r12
+000ca4 e59bc014 LDR r12,[r11,#0x14]
+000ca8 e79c1081 LDR r1,[r12,r1,LSL #1]
+000cac e5cd1508 STRB r1,[r13,#0x508]
+000cb0 e4961004 LDR r1,[r6],#4
+000cb4 e59bc00c LDR r12,[r11,#0xc]
+000cb8 e041100c SUB r1,r1,r12
+000cbc e59bc010 LDR r12,[r11,#0x10]
+000cc0 e79c1081 LDR r1,[r12,r1,LSL #1]
+000cc4 e5cd150c STRB r1,[r13,#0x50c]
+000cc8 e1a01441 MOV r1,r1,ASR #8
+000ccc e5cd150d STRB r1,[r13,#0x50d]
+000cd0 e3a0c001 MOV r12,#1
+000cd4 e1a0331c MOV r3,r12,LSL r3
+000cd8 e1a0103e MOV r1,r14,LSR r0
+000cdc e1510007 CMP r1,r7
+000ce0 e58d3514 STR r3,[r13,#0x514]
+000ce4 2a000008 BCS 0xd0c
+000ce8 e088a181 ADD r10,r8,r1,LSL #3
+000cec e28d9f42 ADD r9,r13,#0x108
+000cf0 e2899b01 ADD r9,r9,#0x400
+000cf4 e8991008 LDMIA r9,{r3,r12}
+000cf8 e88a1008 STMIA r10,{r3,r12}
+000cfc e59d3514 LDR r3,[r13,#0x514]
+000d00 e0811003 ADD r1,r1,r3
+000d04 e1510007 CMP r1,r7
+000d08 3afffff6 BCC 0xce8
+000d0c e3a0c001 MOV r12,#1
+000d10 e59d1560 LDR r1,[r13,#0x560]
+000d14 e11e0001 TST r14,r1
+000d18 0a000003 BEQ 0xd2c
+000d1c e02ee001 EOR r14,r14,r1
+000d20 e1a010a1 MOV r1,r1,LSR #1
+000d24 e11e0001 TST r14,r1
+000d28 1afffffb BNE 0xd1c
+000d2c e02ee001 EOR r14,r14,r1
+000d30 e1a0101c MOV r1,r12,LSL r0
+000d34 e2411001 SUB r1,r1,#1
+000d38 e001100e AND r1,r1,r14
+000d3c e28d3004 ADD r3,r13,#4
+000d40 e7933104 LDR r3,[r3,r4,LSL #2]
+000d44 e1310003 TEQ r1,r3
+000d48 0a000008 BEQ 0xd70
+000d4c e2444001 SUB r4,r4,#1
+000d50 e0400002 SUB r0,r0,r2
+000d54 e1a0101c MOV r1,r12,LSL r0
+000d58 e2411001 SUB r1,r1,#1
+000d5c e001300e AND r3,r1,r14
+000d60 e28d1004 ADD r1,r13,#4
+000d64 e7911104 LDR r1,[r1,r4,LSL #2]
+000d68 e1330001 TEQ r3,r1
+000d6c 1afffff6 BNE 0xd4c
+000d70 e59d155c LDR r1,[r13,#0x55c]
+000d74 e2413001 SUB r3,r1,#1
+000d78 e3310000 TEQ r1,#0
+000d7c e58d355c STR r3,[r13,#0x55c]
+000d80 1affff6c BNE 0xb38
+000d84 e2855001 ADD r5,r5,#1
+000d88 e59d3510 LDR r3,[r13,#0x510]
+000d8c e1550003 CMP r5,r3
+000d90 daffff59 BLE 0xafc
+000d94 e59d7000 LDR r7,[r13,#0]
+000d98 e3370000 TEQ r7,#0
+000d9c 159d3510 LDRNE r3,[r13,#0x510]
+000da0 13330001 TEQNE r3,#1
+000da4 03a00000 MOVEQ r0,#0
+000da8 13a00001 MOVNE r0,#1
+000dac e91baff0 LDMDB r11,{r4-r11,r13,pc}
+000db0 e1a0c00d MOV r12,r13
+000db4 e92dd8f0 STMDB r13!,{r4-r7,r11,r12,r14,pc}
+000db8 e24cb004 SUB r11,r12,#4
+000dbc e1a04002 MOV r4,r2
+000dc0 e1a02003 MOV r2,r3
+000dc4 e3a03000 MOV r3,#0
+000dc8 e3a00008 MOV r0,#8
+000dcc e28b6008 ADD r6,r11,#8
+000dd0 e8960060 LDMIA r6,{r5,r6}
+000dd4 e59b7004 LDR r7,[r11,#4]
+000dd8 e7850103 STR r0,[r5,r3,LSL #2]
+000ddc e2833001 ADD r3,r3,#1
+000de0 e3530090 CMP r3,#0x90
+000de4 bafffffb BLT 0xdd8
+000de8 e3a0c009 MOV r12,#9
+000dec e3530c01 CMP r3,#0x100
+000df0 aa000003 BGE 0xe04
+000df4 e785c103 STR r12,[r5,r3,LSL #2]
+000df8 e2833001 ADD r3,r3,#1
+000dfc e3530c01 CMP r3,#0x100
+000e00 bafffffb BLT 0xdf4
+000e04 e3a0c007 MOV r12,#7
+000e08 e3530f46 CMP r3,#0x118
+000e0c aa000003 BGE 0xe20
+000e10 e785c103 STR r12,[r5,r3,LSL #2]
+000e14 e2833001 ADD r3,r3,#1
+000e18 e3530f46 CMP r3,#0x118
+000e1c bafffffb BLT 0xe10
+000e20 e3530e12 CMP r3,#0x120
+000e24 aa000003 BGE 0xe38
+000e28 e7850103 STR r0,[r5,r3,LSL #2]
+000e2c e2833001 ADD r3,r3,#1
+000e30 e3530e12 CMP r3,#0x120
+000e34 bafffffb BLT 0xe28
+000e38 e1a03006 MOV r3,r6
+000e3c e582c000 STR r12,[r2,#0]
+000e40 e5960014 LDR r0,[r6,#0x14]
+000e44 e92d000f STMDB r13!,{r0-r3}
+000e48 e1a00005 MOV r0,r5
+000e4c e3a02001 MOV r2,#1
+000e50 e2822c01 ADD r2,r2,#0x100
+000e54 e3a01e12 MOV r1,#0x120
+000e58 e5963010 LDR r3,[r6,#0x10]
+000e60 e28dd010 ADD r13,r13,#0x10
+000e64 e1b03000 MOVS r3,r0
+000e68 191ba8f0 LDMNEDB r11,{r4-r7,r11,r13,pc}
+000e6c e3a00005 MOV r0,#5
+000e70 e7850103 STR r0,[r5,r3,LSL #2]
+000e74 e2833001 ADD r3,r3,#1
+000e78 e353001e CMP r3,#0x1e
+000e7c bafffffb BLT 0xe70
+000e80 e1a03006 MOV r3,r6
+000e84 e5870000 STR r0,[r7,#0]
+000e88 e1a02007 MOV r2,r7
+000e8c e1a01004 MOV r1,r4
+000e90 e596001c LDR r0,[r6,#0x1c]
+000e94 e92d000f STMDB r13!,{r0-r3}
+000e98 e1a00005 MOV r0,r5
+000e9c e3a02000 MOV r2,#0
+000ea0 e3a0101e MOV r1,#0x1e
+000ea4 e5b63018 LDR r3,[r6,#0x18]!
+000eac e28dd010 ADD r13,r13,#0x10
+000eb0 e3500001 CMP r0,#1
+000eb4 d3a00000 MOVLE r0,#0
+000eb8 e91ba8f0 LDMDB r11,{r4-r7,r11,r13,pc}
+000ebc e1a0c00d MOV r12,r13
+000ec0 e92d000f STMDB r13!,{r0-r3}
+000ec4 e92ddff0 STMDB r13!,{r4-r12,r14,pc}
+000ec8 e24cb014 SUB r11,r12,#0x14
+000ecc e1a04003 MOV r4,r3
+000ed0 e59b501c LDR r5,[r11,#0x1c]
+000ed4 e59b8018 LDR r8,[r11,#0x18]
+000ed8 e24dd00c SUB r13,r13,#0xc
+000edc e5951000 LDR r1,[r5,#0]
+000ee0 e1a02005 MOV r2,r5
+000ee4 e3a00005 MOV r0,#5
+000eec e200101f AND r1,r0,#0x1f
+000ef0 e2811001 ADD r1,r1,#1
+000ef4 e2811c01 ADD r1,r1,#0x100
+000ef8 e58d1004 STR r1,[r13,#4]
+000efc e1a012a0 MOV r1,r0,LSR #5
+000f00 e5950004 LDR r0,[r5,#4]
+000f04 e2400005 SUB r0,r0,#5
+000f08 e5850004 STR r0,[r5,#4]
+000f0c e1a02005 MOV r2,r5
+000f10 e3a00005 MOV r0,#5
+000f18 e200101f AND r1,r0,#0x1f
+000f1c e2811001 ADD r1,r1,#1
+000f20 e58d1000 STR r1,[r13,#0]
+000f24 e1a012a0 MOV r1,r0,LSR #5
+000f28 e5950004 LDR r0,[r5,#4]
+000f2c e2400005 SUB r0,r0,#5
+000f30 e5850004 STR r0,[r5,#4]
+000f34 e1a02005 MOV r2,r5
+000f38 e3a00004 MOV r0,#4
+000f40 e200100f AND r1,r0,#0xf
+000f44 e2819004 ADD r9,r1,#4
+000f48 e1a07220 MOV r7,r0,LSR #4
+000f4c e5950004 LDR r0,[r5,#4]
+000f50 e2400004 SUB r0,r0,#4
+000f54 e5850004 STR r0,[r5,#4]
+000f58 e3a0a001 MOV r10,#1
+000f5c e59d0004 LDR r0,[r13,#4]
+000f60 e250cf47 SUBS r12,r0,#0x11c
+000f64 a35c0002 CMPGE r12,#2
+000f68 959d0000 LDRLS r0,[r13,#0]
+000f6c 9350001e CMPLS r0,#0x1e
+000f70 81a0000a MOVHI r0,r10
+000f74 8a0000c4 BHI 0x128c
+000f78 e3a06000 MOV r6,#0
+000f7c e3590000 CMP r9,#0
+000f80 8a000001 BHI 0xf8c
+000f84 e3a01000 MOV r1,#0
+000f88 ea000011 B 0xfd4
+000f8c e1a02005 MOV r2,r5
+000f90 e1a01007 MOV r1,r7
+000f94 e3a00003 MOV r0,#3
+000f9c e2002007 AND r2,r0,#7
+000fa0 e595100c LDR r1,[r5,#0xc]
+000fa4 e7911106 LDR r1,[r1,r6,LSL #2]
+000fa8 e7882101 STR r2,[r8,r1,LSL #2]
+000fac e1a071a0 MOV r7,r0,LSR #3
+000fb0 e5950004 LDR r0,[r5,#4]
+000fb4 e2400003 SUB r0,r0,#3
+000fb8 e2866001 ADD r6,r6,#1
+000fbc e1560009 CMP r6,r9
+000fc0 e5850004 STR r0,[r5,#4]
+000fc4 3afffff0 BCC 0xf8c
+000fc8 e3560013 CMP r6,#0x13
+000fcc 3affffec BCC 0xf84
+000fd0 ea000005 B 0xfec
+000fd4 e595000c LDR r0,[r5,#0xc]
+000fd8 e7900106 LDR r0,[r0,r6,LSL #2]
+000fdc e7881100 STR r1,[r8,r0,LSL #2]
+000fe0 e2866001 ADD r6,r6,#1
+000fe4 e3560013 CMP r6,#0x13
+000fe8 3afffff9 BCC 0xfd4
+000fec e3a00007 MOV r0,#7
+000ff0 e1a03005 MOV r3,r5
+000ff4 e5840000 STR r0,[r4,#0]
+000ff8 e1a02004 MOV r2,r4
+000ffc e3a00000 MOV r0,#0
+001000 e59b1008 LDR r1,[r11,#8]
+001004 e92d000f STMDB r13!,{r0-r3}
+001008 e1a00008 MOV r0,r8
+00100c e3a03000 MOV r3,#0
+001010 e3a02013 MOV r2,#0x13
+001014 e3a01013 MOV r1,#0x13
+00101c e28dd010 ADD r13,r13,#0x10
+001020 e1b06000 MOVS r6,r0
+001024 0a000001 BEQ 0x1030
+001028 e3360001 TEQ r6,#1
+00102c 0a000096 BEQ 0x128c
+001030 e89d0003 LDMIA r13,{r0,r1}
+001034 e0819000 ADD r9,r1,r0
+001038 e3a0a001 MOV r10,#1
+00103c e5940000 LDR r0,[r4,#0]
+001040 e1a0001a MOV r0,r10,LSL r0
+001044 e2402001 SUB r2,r0,#1
+001048 e3a06000 MOV r6,#0
+00104c e1a0a006 MOV r10,r6
+001050 e3590000 CMP r9,#0
+001054 e58d2008 STR r2,[r13,#8]
+001058 9a000068 BLS 0x1200
+00105c e1a02005 MOV r2,r5
+001060 e1a01007 MOV r1,r7
+001064 e5940000 LDR r0,[r4,#0]
+00106c e1a01000 MOV r1,r0
+001070 e59d2008 LDR r2,[r13,#8]
+001074 e0000002 AND r0,r0,r2
+001078 e59b2008 LDR r2,[r11,#8]
+00107c e5922000 LDR r2,[r2,#0]
+001080 e0820180 ADD r0,r2,r0,LSL #3
+001084 e59b200c LDR r2,[r11,#0xc]
+001088 e5820000 STR r0,[r2,#0]
+00108c e5d00001 LDRB r0,[r0,#1]
+001090 e1a07031 MOV r7,r1,LSR r0
+001094 e5951004 LDR r1,[r5,#4]
+001098 e0410000 SUB r0,r1,r0
+00109c e5850004 STR r0,[r5,#4]
+0010a0 e59b200c LDR r2,[r11,#0xc]
+0010a4 e5920000 LDR r0,[r2,#0]
+0010a8 e5900004 LDR r0,[r0,#4]
+0010ac e1a00800 MOV r0,r0,LSL #16
+0010b0 e1a00820 MOV r0,r0,LSR #16
+0010b4 e3500010 CMP r0,#0x10
+0010b8 2a000004 BCS 0x10d0
+0010bc e1a0a000 MOV r10,r0
+0010c0 e1a00006 MOV r0,r6
+0010c4 e2866001 ADD r6,r6,#1
+0010c8 e788a100 STR r10,[r8,r0,LSL #2]
+0010cc ea000049 B 0x11f8
+0010d0 1a000018 BNE 0x1138
+0010d4 e1a02005 MOV r2,r5
+0010d8 e1a01007 MOV r1,r7
+0010dc e3a00002 MOV r0,#2
+0010e4 e2001003 AND r1,r0,#3
+0010e8 e2811003 ADD r1,r1,#3
+0010ec e1a07120 MOV r7,r0,LSR #2
+0010f0 e5950004 LDR r0,[r5,#4]
+0010f4 e2400002 SUB r0,r0,#2
+0010f8 e5850004 STR r0,[r5,#4]
+0010fc e0860001 ADD r0,r6,r1
+001100 e1500009 CMP r0,r9
+001104 9a000001 BLS 0x1110
+001108 e3a00001 MOV r0,#1
+00110c ea00005e B 0x128c
+001110 e2410001 SUB r0,r1,#1
+001114 e3310000 TEQ r1,#0
+001118 0a000036 BEQ 0x11f8
+00111c e1a01006 MOV r1,r6
+001120 e2866001 ADD r6,r6,#1
+001124 e788a101 STR r10,[r8,r1,LSL #2]
+001128 e1b01000 MOVS r1,r0
+00112c e2400001 SUB r0,r0,#1
+001130 1afffff9 BNE 0x111c
+001134 ea00002f B 0x11f8
+001138 e3300011 TEQ r0,#0x11
+00113c e1a02005 MOV r2,r5
+001140 e1a01007 MOV r1,r7
+001144 1a000015 BNE 0x11a0
+001148 e3a00003 MOV r0,#3
+001150 e2001007 AND r1,r0,#7
+001154 e2811003 ADD r1,r1,#3
+001158 e1a071a0 MOV r7,r0,LSR #3
+00115c e5950004 LDR r0,[r5,#4]
+001160 e2400003 SUB r0,r0,#3
+001164 e5850004 STR r0,[r5,#4]
+001168 e0860001 ADD r0,r6,r1
+00116c e1500009 CMP r0,r9
+001170 8affffe4 BHI 0x1108
+001174 e2410001 SUB r0,r1,#1
+001178 e3310000 TEQ r1,#0
+00117c 0a00001c BEQ 0x11f4
+001180 e3a02000 MOV r2,#0
+001184 e1a01006 MOV r1,r6
+001188 e2866001 ADD r6,r6,#1
+00118c e7882101 STR r2,[r8,r1,LSL #2]
+001190 e1b01000 MOVS r1,r0
+001194 e2400001 SUB r0,r0,#1
+001198 1afffff9 BNE 0x1184
+00119c ea000014 B 0x11f4
+0011a0 e3a00007 MOV r0,#7
+0011a8 e200107f AND r1,r0,#0x7f
+0011ac e281100b ADD r1,r1,#0xb
+0011b0 e1a073a0 MOV r7,r0,LSR #7
+0011b4 e5950004 LDR r0,[r5,#4]
+0011b8 e2400007 SUB r0,r0,#7
+0011bc e5850004 STR r0,[r5,#4]
+0011c0 e0860001 ADD r0,r6,r1
+0011c4 e1500009 CMP r0,r9
+0011c8 8affffce BHI 0x1108
+0011cc e2410001 SUB r0,r1,#1
+0011d0 e3310000 TEQ r1,#0
+0011d4 0a000006 BEQ 0x11f4
+0011d8 e3a02000 MOV r2,#0
+0011dc e1a01006 MOV r1,r6
+0011e0 e2866001 ADD r6,r6,#1
+0011e4 e7882101 STR r2,[r8,r1,LSL #2]
+0011e8 e1b01000 MOVS r1,r0
+0011ec e2400001 SUB r0,r0,#1
+0011f0 1afffff9 BNE 0x11dc
+0011f4 e3a0a000 MOV r10,#0
+0011f8 e1560009 CMP r6,r9
+0011fc 3affff96 BCC 0x105c
+001200 e5950020 LDR r0,[r5,#0x20]
+001204 e585007c STR r0,[r5,#0x7c]
+001208 e3a00009 MOV r0,#9
+00120c e5857000 STR r7,[r5,#0]
+001210 e1a03005 MOV r3,r5
+001214 e5840000 STR r0,[r4,#0]
+001218 e1a02004 MOV r2,r4
+00121c e59b1008 LDR r1,[r11,#8]
+001220 e5950014 LDR r0,[r5,#0x14]
+001224 e92d000f STMDB r13!,{r0-r3}
+001228 e5953010 LDR r3,[r5,#0x10]
+00122c e1a00008 MOV r0,r8
+001230 e3a02001 MOV r2,#1
+001234 e2822c01 ADD r2,r2,#0x100
+001238 e59d1014 LDR r1,[r13,#0x14]
+001240 e28dd010 ADD r13,r13,#0x10
+001244 e3300000 TEQ r0,#0
+001248 1a00000f BNE 0x128c
+00124c e3a00006 MOV r0,#6
+001250 e59b2014 LDR r2,[r11,#0x14]
+001254 e1a03005 MOV r3,r5
+001258 e5820000 STR r0,[r2,#0]
+00125c e59b100c LDR r1,[r11,#0xc]
+001260 e59b2014 LDR r2,[r11,#0x14]
+001264 e595001c LDR r0,[r5,#0x1c]
+001268 e92d000f STMDB r13!,{r0-r3}
+00126c e5b53018 LDR r3,[r5,#0x18]!
+001270 e59d0014 LDR r0,[r13,#0x14]
+001274 e0880100 ADD r0,r8,r0,LSL #2
+001278 e3a02000 MOV r2,#0
+00127c e59d1010 LDR r1,[r13,#0x10]
+001284 e28dd010 ADD r13,r13,#0x10
+001288 e3300000 TEQ r0,#0
+00128c e91baff0 LDMDB r11,{r4-r11,r13,pc}
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2008 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/testasm.txt
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/testmmu.fth
===================================================================
--- cpu/arm/testmmu.fth (rev 0)
+++ cpu/arm/testmmu.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,3 @@
+select /mmu
+1000 1000 claim constant pf
+40000000 pf 1000 -2 map
Property changes on: cpu/arm/testmmu.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/tools.bth
===================================================================
--- cpu/arm/tools.bth (rev 0)
+++ cpu/arm/tools.bth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,47 @@
+purpose: Load file for Forth toolkit, without firmware
+\ See license at end of file
+
+dictionary: ${BP}/cpu/arm/build/kernel.dic
+command: &armforth &dictionary &this
+build-now
+
+\ ' $report-name is include-hook
+\ ' noop is include-hook
+\ : rn (cr 2dup type 15 spaces ; ' rn is include-hook
+
+fload ${BP}/forth/lib/fwsetup.fth
+
+transient
+true value assembler? \ False to discard assembler after compilation
+resident
+
+fload ${BP}/forth/lib/loadcomm.fth \ CPU-independent Forth tools
+fload ${BP}/cpu/arm/loadmach.fth \ CPU and OS-specific extensions
+
+[ifndef] no-heads
+.( --- Saving tools.dic --- ) " tools.dic" $save-forth cr
+[then]
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1994 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/tools.bth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/traps.fth
===================================================================
--- cpu/arm/traps.fth (rev 0)
+++ cpu/arm/traps.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,82 @@
+purpose: Save the processor state after an exception - hardware version
+\ See license at end of file
+
+only forth also hidden also forth definitions
+
+\ The common subroutines on which this depends are defined in
+\ cpu/arm/register.fth
+
+headerless
+
+\ This is the first part of the exception handling sequence and the last
+\ half of the exception restart sequence. It is executed in exception state.
+
+label hw-save-state
+ \ On entry: r13: scratch r14: PC from old mode
+
+ \ Check for second half of (restart, if so restore all the registers
+ \ from the save area and return from the exception.
+
+ 'code (restart drop restart-offset + ( offset )
+ adr r13,* \ Address of trap in (restart
+
+ dec r14,1cell \ Point to the trapped instruction
+ cmp r13,r14
+
+ adr r13,'body main-task \ Get user pointer address
+ ldr r13,[r13] \ Get user pointer
+ ldr r13,[r13,`'user# cpu-state`] \ State save address
+
+ beq 'body restart-common
+
+ stmia r13,{r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11,r12}
+
+ mov r0,r13 \ Move cpu-state pointer into r0
+ mov r4,#0 \ Set r4 to 0 to indicate no user abort
+ b 'body save-common
+end-code
+
+: hw-install-handler ( handler exception# -- )
+ \ Put "ldr pc,[pc,40-8]" in exception vector at 0 + (exception# * 4)
+ h# e59ff038 over /l* instruction! ( exception# )
+
+ \ Put handler address in address table at 40 + (exception# * 4)
+ h# 40 swap la+ l!
+;
+: hw-catch-exception ( exception# -- ) hw-save-state swap install-handler ;
+
+: stand-init-io ( -- )
+ stand-init-io
+ ['] (restart is restart
+ ['] hw-install-handler is install-handler
+ ['] hw-catch-exception is catch-exception
+ catch-exceptions
+ 2 catch-exception \ Software interrupt (we don't catch this under DEMON)
+;
+
+headers
+only forth also definitions
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1997 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Property changes on: cpu/arm/traps.fth
___________________________________________________________________
Added: svn:executable
+ *
Added: cpu/arm/version.fth
===================================================================
--- cpu/arm/version.fth (rev 0)
+++ cpu/arm/version.fth 2008-12-20 07:55:35 UTC (rev 1039)
@@ -0,0 +1,5 @@
+defer title
+: .copyright (s -- )
+ ." Forthmacs for ARM, Copyright (c) 1988-2008 FirmWorks" cr
+;
+' .copyright is title
Property changes on: cpu/arm/version.fth
___________________________________________________________________
Added: svn:executable
+ *
More information about the openfirmware
mailing list