Author: wmb Date: Fri Dec 2 02:05:04 2011 New Revision: 2719 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2719
Log: x86 kernel - Added the option of building a dynamically-relocated version. So far it isn't used in any target platform builds, but when the time comes, it will be especially useful for generic versions where you don't know a priori how much memory is available.
Added: cpu/x86/basefwrel.bth cpu/x86/builderrel.bth cpu/x86/kernelrel.bth cpu/x86/nullrel.fth - copied, changed from r2718, cpu/x86/savefort.fth cpu/x86/toolsrel.bth Modified: cpu/x86/basefw.bth cpu/x86/boot.fth cpu/x86/build/builder.dic cpu/x86/builder.bth cpu/x86/kerncode.fth cpu/x86/kernel.bth cpu/x86/metainit.fth cpu/x86/metarel.fth cpu/x86/objsup.fth cpu/x86/saveexp.fth cpu/x86/savefort.fth cpu/x86/savemeta.fth cpu/x86/syscall.fth cpu/x86/target.fth cpu/x86/tools.bth forth/kernel/kernel.fth forth/lib/brackif.fth forth/wrapper/wrapper.c
Modified: cpu/x86/basefw.bth ============================================================================== --- cpu/x86/basefw.bth Fri Dec 2 02:04:52 2011 (r2718) +++ cpu/x86/basefw.bth Fri Dec 2 02:05:04 2011 (r2719) @@ -129,8 +129,8 @@
tag-file @ fclose tag-file off
-cr .( --- Saving basefw.dic --- ) " basefw.dic" $save-forth cr - +- rel cr .( --- Saving basefw.dic --- ) " basefw.dic" $save-forth cr ++ rel cr .( --- Saving basefwrel.dic --- ) " basefwrel.dic" $save-forth cr [then]
\ LICENSE_BEGIN
Added: cpu/x86/basefwrel.bth ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ cpu/x86/basefwrel.bth Fri Dec 2 02:05:04 2011 (r2719) @@ -0,0 +1,8 @@ +\ See license at end of file +purpose: Load file for Forth toolkit, without firmware + +dictionary: ${BP}/cpu/x86/build/toolsrel.dic +command: &x86forth &dictionary &this +build-now + +fload ${BP}/cpu/x86/basefw.bth
Modified: cpu/x86/boot.fth ============================================================================== --- cpu/x86/boot.fth Fri Dec 2 02:04:52 2011 (r2718) +++ cpu/x86/boot.fth Fri Dec 2 02:05:04 2011 (r2719) @@ -1,12 +1,8 @@ \ See license at end of file
-\ Version for running Forth under DOS, either under the Phar Lap -\ DOS Extender or under the Zortech C DOS Extender. - -\ Boot code (cold and warm start). The cold start code is executed +\ Boot code (cold start). The cold start code is executed \ when Forth is initially started. Its job is to initialize the Forth -\ virtual machine registers. The warm start code is executed when Forth -\ is re-entered, perhaps as a result of an exception. +\ virtual machine registers.
hex
@@ -32,8 +28,10 @@ mlabel cold-code
forth-h -h# e9 origin-t c!-t \ Relative jump with 32-bit offset -here-t origin-t 5 + - origin-t 1+ !-t \ Offset relative to instruction end +- rel-t h# e9 origin-t c!-t \ Relative jump with 32-bit offset +- rel-t here-t origin-t 5 + - origin-t 1+ !-t \ Offset relative to instruction end ++ rel-t h# e9 jmp-header c! \ Relative jump with 32-bit offset ++ rel-t here-t /jmp-header + 5 - jmp-header 1+ le-l! \ Offset relative to instruction end assembler
\ The segment registers are set correctly, and the stack pointer is @@ -41,11 +39,15 @@
\ Get the origin address here-t 5 + #) call here-t origin-t - ( offset ) - bx pop - ( offset ) # bx sub \ Origin in bx +- rel-t bx pop +- rel-t ( offset ) # bx sub \ Origin in bx + ++ rel-t up pop ++ rel-t ( offset ) # up sub \ Origin in up
- 20 [bx] di lea - di 'user up0 mov \ initialize up0 (needed for future relocation) +- rel-t 20 [bx] up lea +- rel-t up 'user up0 mov \ initialize up0 (needed for future relocation) ++ rel-t up 'user up0 mov \ initialize up0 (needed for future relocation)
\ Set the value of flat? so later code can determine whether or \ not it is safe to do things like setting the stack segment descriptor, @@ -66,33 +68,37 @@ sp ax mov
[ifdef] notdef -\ this version is ROMable +\ this version is ROMable - and is incompatible with relative addressing \ Allocate the RAM copy of the User Area user-size-t # sp sub
\ Copy the initial User Area image to the RAM copy - userarea-t [bx] si lea \ Source address for copy + rel-t userarea-t [bx] si lea \ Source address for copy sp di mov \ Destination of copy user-size-t # cx mov \ Number of bytes to copy cld rep byte movs
- sp di mov \ Set user pointer + sp up mov \ Set user pointer [else] - userarea-t [bx] di lea \ Source address for copy +- rel-t userarea-t [bx] up lea \ User pointer ++ rel-t userarea-t [up] up lea \ User pointer [then]
\ XXX need to swap bytes \ Set main-task so the exception handler can find the user area - di 'body main-task [bx] mov +- rel-t up 'body main-task [bx] mov ++ rel-t up 'body main-task [up] mov
?bswap-ax ax 'user memtop mov \ Set heap pointer
- h# 10 [bx] ax mov \ #args +- rel-t h# 10 [bx] ax mov \ #args ++ rel-t h# -10 [up] ax mov \ #args ?bswap-ax ax 'user #args mov
- h# 14 [bx] ax mov \ args +- rel-t h# 14 [bx] ax mov \ args ++ rel-t h# -c [up] ax mov \ args ?bswap-ax ax 'user args mov
@@ -123,62 +129,22 @@ ps-size-t # ax sub \ allocate space for the data stack ax 'user limit mov \ Set dictionary limit
++ rel-t 'user dp ax mov ++ rel-t up ax add ++ rel-t ax 'user dp mov + \ Enter Forth - 'body cold [bx] ip lea +- rel-t 'body cold [bx] ip lea ++ rel-t 'body cold [up] ip lea c;
-create ztc-startup ( -- ) assembler - -\ This is for the Zortech C DOS Extender version which extracts the starting -\ address from location c and jumps directly to it. - -forth-h -\ here-t origin-t h# c + le-l!-t \ Address of ztc-startup relative to origin -here-t h# 0c token!-t \ Address of ztc-startup relative to origin -assembler - -\ The stack contains: -\ ( Data selector [4 bytes], memory size [4 bytes], return-address [6 bytes] ) - - bp push - sp bp mov - si push - di push - 8 [bp] dx mov \ DX - caller's CS - - ds si mov \ SI - caller's DS - ss di mov \ DI - caller's SS - sp cx mov \ CX - caller's SP - - 0c [bp] ax mov \ Memory top - 10 [bp] ds mov - ds bx mov - - bx ss mov \ Get onto new stack - ax sp mov - - \ GS FS ES DS CS SS SP - gs push fs push es push si push dx push di push cx push - - - dx h# a #) op: mov \ Fix selector of far pointer at origin + 6 - \ Zortech C appears to store it incorrectly - \ memtop @ 8 + le-l@ h# a le-w! - - bx es mov - bx fs mov - bx gs mov - - cold-code #) jmp \ Proceed with the usual startup -end-code - create unix-startup ( -- ) assembler
\ This is the entry point for the Unix wrapper
forth-h -\ here-t origin-t h# 18 + le-l!-t \ Address of unix-startup relative to origin -here-t h# 18 token!-t \ Address of unix-startup relative to origin +- rel-t here-t h# 18 token!-t \ Address of unix-startup ++ rel-t here-t /jmp-header + jmp-header h# 18 + le-l! \ Address of unix-startup assembler
\ The stack contains: @@ -203,28 +169,10 @@ cold-code #) jmp \ Proceed with the usual startup end-code
-create warm-code ( -- ) assembler -\ Set the base address -\ here-t 4 + call \ address of next instruction in spc -\ here-t 4 - base set \ relative address of current instruction -\ spc base base sub \ subtract them to find the base address -\ -\ \ Set the User Pointer -\ 'body main-task up set \ relative address of main-task parameter field -\ up base up add \ absolute address of main-task parameter field -\ up up get \ read the value -\ -\ 'user sp0 sp ld \ Establish the Parameter Stack -\ 'user rp0 rp ld \ Establish the Return Stack -\ 'body warm ip set \ Set IP to execute warm -\ ip base ip add - -next meta
decimal
-\ : install-warm ( -- ) warm-code origin put-branch ; \ : install-cold ( -- ) cold-code origin put-branch ; \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks
Modified: cpu/x86/build/builder.dic ============================================================================== Binary file (source and/or target). No diff available.
Modified: cpu/x86/builder.bth ============================================================================== --- cpu/x86/builder.bth Fri Dec 2 02:04:52 2011 (r2718) +++ cpu/x86/builder.bth Fri Dec 2 02:05:04 2011 (r2719) @@ -7,4 +7,5 @@ fload ${BP}/ofw/tokenizer/tokenize.fth \ Tokenizer fload ${BP}/forth/lib/builder.fth \ Builder
-.( --- Saving builder.dic --- ) " builder.dic" $save-forth cr +- rel .( --- Saving builder.dic --- ) " builder.dic" $save-forth cr ++ rel .( --- Saving builderrel.dic --- ) " builderrel.dic" $save-forth cr
Added: cpu/x86/builderrel.bth ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ cpu/x86/builderrel.bth Fri Dec 2 02:05:04 2011 (r2719) @@ -0,0 +1,7 @@ +purpose: Load file for i386 builder + +dictionary: ${BP}/cpu/x86/build/toolsrel.dic +command: &x86forth &dictionary &this +build-now + +fload ${BP}/cpu/x86/builder.bth
Modified: cpu/x86/kerncode.fth ============================================================================== --- cpu/x86/kerncode.fth Fri Dec 2 02:04:52 2011 (r2718) +++ cpu/x86/kerncode.fth Fri Dec 2 02:05:04 2011 (r2719) @@ -41,7 +41,11 @@ [ifdef] omit-files \ assembler macro to assemble next :-h next - meta-asm[ ax lods 0 [ax] jmp ]meta-asm + meta-asm[ + ax lods ++ rel-t up ax add 0 [ax] bx mov up bx add bx jmp +- rel-t 0 [w] jmp + ]meta-asm ;-h [else] \ assembler macro to assemble next @@ -84,7 +88,10 @@ here-t mlabel >next assembler userarea-t dp-t ! - ax lods 0 [ax] jmp + ax lods + ++ rel-t up ax add 0 [ax] bx mov up bx add bx jmp +- rel-t 0 [w] jmp nop nop nop nop nop end-code dp-t ! @@ -116,11 +123,15 @@ c;
code-field: dovalue - [apf] ax mov ?bswap-ax up ax add 0 [ax] ax mov ?bswap-ax 1push + [apf] ax mov ?bswap-ax up ax add 0 [ax] ax mov ?bswap-ax + 1push c;
code-field: dodefer - [apf] ax mov ?bswap-ax up ax add 0 [ax] w mov 0 [w] jmp + [apf] ax mov ?bswap-ax up ax add 0 [ax] w mov +\ Tail of "next" ++ rel-t up ax add 0 [ax] bx mov up bx add bx jmp +- rel-t 0 [w] jmp end-code
code-field: doconstant @@ -160,17 +171,23 @@
\ ---- Run-time words compiled by compiling words. - code isdefer ( xt -- ) - 0 [ip] ax mov ip ainc /cf [ax] ax mov ?bswap-ax up ax add \ data address in ax + 0 [ip] ax mov ip ainc ++ rel-t up ax add + /cf [ax] ax mov ?bswap-ax up ax add \ data address in ax [ifdef] big-endian-t ax bx mov ax pop ?bswap-ax ax 0 [bx] mov [else] - bx pop bx 0 [ax] mov + bx pop ++ rel-t up bx sub + bx 0 [ax] mov [then] c; + code isvalue ( n -- ) - 0 [ip] ax mov ip ainc /cf [ax] ax mov ?bswap-ax up ax add \ data address in ax + 0 [ip] ax mov ip ainc ++ rel-t up ax add + /cf [ax] ax mov ?bswap-ax up ax add \ data address in ax [ifdef] big-endian-t ax bx mov ax pop ?bswap-ax ax 0 [bx] mov [else] @@ -178,7 +195,9 @@ [then] c; code isuser ( n -- ) - 0 [ip] ax mov ip ainc /cf [ax] ax mov ?bswap-ax up ax add \ data address in ax + 0 [ip] ax mov ip ainc ++ rel-t up ax add + /cf [ax] ax mov ?bswap-ax up ax add \ data address in ax [ifdef] big-endian-t ax bx mov ax pop ?bswap-ax ax 0 [bx] mov [else] @@ -187,11 +206,15 @@ c; code isconstant ( n -- ) 0 [ip] bx mov ip ainc - ax pop ?bswap-ax ax /cf [bx] mov + ax pop ?bswap-ax ++ rel-t up bx add + ax /cf [bx] mov c; code isvariable ( n -- ) 0 [ip] bx mov ip ainc - ax pop ?bswap-ax ax /cf [bx] mov + ax pop ?bswap-ax ++ rel-t up bx add + ax /cf [bx] mov c;
code bswap (s n1 -- n2 ) @@ -220,7 +243,12 @@ [then]
\ Execute a Forth word given a code field address -code execute (s acf -- ) w pop 0 [w] jmp end-code +code execute (s acf -- ) + w pop +\ Partial tail of "next" ++ rel-t 0 [ax] bx mov up bx add bx jmp +- rel-t 0 [w] jmp +end-code
\ execute-ip This word will call a block of Forth words given the address \ of the first word. It's used, for example, in try blocks where the @@ -743,7 +771,11 @@ ax pop ax pop ax pop ax pop ax pop c;
-code (') (s -- acf ) ax lods 1push c; +code (') (s -- acf ) + ax lods ++ rel-t up ax add + 1push +c;
\ Modifies caller's ip to skip over an in-line string code skipstr (s -- addr len) @@ -886,20 +918,32 @@ \ >target depends on the way that branches are compiled : >target ( ip-of-branch-instruction -- target ) ta1+ dup branch@ + ;
++ rel-t create rel + headerless /a constant /a -code a@ ( adr1 -- adr2 ) bx pop 0 [bx] push c; +code a@ (s addr -- cfa ) + ax pop ++ rel-t 0 [ax] ax mov up ax add ax push +- rel-t 0 [ax] push +c; \ [ifdef] big-endian-t -: a! ( adr1 adr2 -- ) set-relocation-bit le-! ; ++ rel-t code a! ( xt adr -- ) bx pop ax pop up ax sub ax 0 [bx] mov c; +- rel-t : a! ( adr1 adr2 -- ) set-relocation-bit le-! ; \ [else] \ code a! ( adr1 adr2 -- ) bx pop 0 [bx] pop c; \ [then] : a, ( adr -- ) here /a allot a! ;
/token constant /token -code token@ (s addr -- cfa ) bx pop 0 [bx] push c; +code token@ (s addr -- cfa ) + ax pop ++ rel-t 0 [ax] ax mov up ax add ax push +- rel-t 0 [ax] push +c; \ [ifdef] big-endian-t -: token! ( adr1 adr2 -- ) set-relocation-bit le-! ; ++ rel-t code token! ( xt adr -- ) bx pop ax pop up ax sub ax 0 [bx] mov c; +- rel-t : token! ( adr1 adr2 -- ) set-relocation-bit le-! ; \ [else] \ code token! (s cfa addr -- ) bx pop 0 [bx] pop c; \ [then] @@ -916,9 +960,9 @@ : another-link? ( adr -- false | link true ) link@ non-null? ;
-origin-t constant origin - /n negate allot-t origin-t token,-t ( make origin relocatable ) - ++ rel-t code origin (s -- addr ) up push c; +- rel-t origin-t constant origin +- rel-t /n negate allot-t origin-t token,-t ( make origin relocatable )
\ The "word type" is a number which distinguishes one type of word \ from another. This is highly implementation-dependent. @@ -1098,10 +1142,12 @@ di push \ Save UP cx cx xor \ Clear high bytes
- here-t 5 + #) call \ Figure out the origin address - here-t - bp pop - origin-t - # bp sub ++ rel-t up bp mov \ up (==di) is the origin, but we need to use di for string compare + +- rel-t here-t 5 + #) call \ Figure out the origin address +- rel-t here-t +- rel-t bp pop +- rel-t origin-t - # bp sub
ahead begin @@ -1136,7 +1182,8 @@ but then \ The names did not match, so check the next name in the list 0 [ax] ax mov \ Fetch next link - ax bp cmp \ Test for end of list ++ rel-t bp ax add + ax bp cmp \ Test for end of list 0= until
\ If we get here, we've checked all the names with no luck
Modified: cpu/x86/kernel.bth ============================================================================== --- cpu/x86/kernel.bth Fri Dec 2 02:04:52 2011 (r2718) +++ cpu/x86/kernel.bth Fri Dec 2 02:05:04 2011 (r2719) @@ -4,6 +4,16 @@ command: &builder &this build-now
+: defined? ( "name" -- flag ) + safe-parse-word $find dup if nip else nip nip then +; +: + ( "name" "rest of line" -- ) + defined? 0= if [compile] \ then +; immediate +: - ( "name" "rest of line" -- ) + defined? if [compile] \ then +; immediate + \ [ifdef] use-postfix-assembler \ use-postfix-assembler \ ' 386-assembler >link fence a! @@ -23,16 +33,16 @@ [ifdef] big-endian-t create dic-file-name ," kernelbe.dic" [else] -create dic-file-name ," kernel.dic" +- rel-t create dic-file-name ," kernel.dic" ++ rel-t create dic-file-name ," kernelrel.dic" [then] [then]
: \Tags [compile] \ ; immediate : \NotTags ; immediate
- -\ ' $report-name is include-hook ' noop is include-exit-hook ' noop is include-hook ' noop is include-exit-hook +\ ' $report-name is include-hook ' noop is include-exit-hook
warning off \ Turn OFF the warning messages
@@ -45,6 +55,11 @@
: resident ;
+\ : \rel-t ( -- ) [compile] \ ; immediate +\ : !rel-t ( -- ) ; immediate +\ : \rel-t ( -- ) ; immediate +\ : !rel-t ( -- ) [compile] \ ; immediate + fload ${BP}/forth/kernel/conft32.fth fload ${BP}/forth/kernel/meta1.fth
@@ -64,14 +79,7 @@ fload ${BP}/cpu/x86/fixvoc.fth fload ${BP}/forth/kernel/metacompile.fth
-fload ${BP}/cpu/x86/metarel.fth - -only forth meta also forth also definitions -defer relocation-map -' relocation-map-t is relocation-map -' meta-set-relocation-bit is set-relocation-bit-t -' meta-init-relocation is init-relocation-t -only forth also definitions +- rel-t fload ${BP}/cpu/x86/metarel.fth
fload ${BP}/cpu/x86/metainit.fth
@@ -99,12 +107,11 @@
fload ${BP}/forth/lib/bitops.fth [ifdef] omit-files -defer set-relocation-bit -defer clear-relocation-bits -' noop is set-relocation-bit -' 2drop is clear-relocation-bits +defer set-relocation-bit ' noop is set-relocation-bit +defer clear-relocation-bits ' 2drop is clear-relocation-bits [else] -fload ${BP}/cpu/x86/kernrel.fth +- rel-t fload ${BP}/cpu/x86/kernrel.fth ++ rel-t fload ${BP}/cpu/x86/nullrel.fth [then]
fload ${BP}/forth/lib/struct.fth
Added: cpu/x86/kernelrel.bth ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ cpu/x86/kernelrel.bth Fri Dec 2 02:05:04 2011 (r2719) @@ -0,0 +1,8 @@ +purpose: Load file for x86 Forth kernel +\ See license at end of file + +command: &builder &this +build-now + +create rel-t +fload ${BP}/cpu/x86/kernel.bth
Modified: cpu/x86/metainit.fth ============================================================================== --- cpu/x86/metainit.fth Fri Dec 2 02:04:52 2011 (r2718) +++ cpu/x86/metainit.fth Fri Dec 2 02:05:04 2011 (r2719) @@ -8,6 +8,10 @@ warning off forth definitions
++ rel-t \ This is prepended to the dictionary image ++ rel-t h# 20 constant /jmp-header ++ rel-t /jmp-header buffer: jmp-header + metaon meta definitions
@@ -23,7 +27,7 @@ \ This number is a target token rather than an absolute address. hex
-0.0000 org 0.0000 + 0 org 0 voc-link-t token-t!
ps-size-t equ ps-size @@ -41,30 +45,30 @@ hex mlabel cld
-\ boot.fth will store a jmp instruction to cold-code at this location, -\ so that the PharLap DOS extender may execute the Forth image directly -\ by jumping to its beginning address. -( offset 0 ) 0 c,-t 0 l,-t - -\ This byte is unused -( offset 5 ) 0 c,-t - -\ The Zortech loader will put a far pointer to EMACS at location 6 -( offset 6 ) 0 l,-t 0 w,-t - -\ boot.fth will store the address of cold-code at this location. -\ The Zortech-based protected-mode loader reads this location to find the -\ place to begin execution. Zortech's null-pointer detection prevents -\ the use of location zero. -( offset c ) 0 l,-t - -\ These location are used for the argc and argv values for the Zortech loader - -( offset 10 ) 0 l,-t \ argc (set by Zortech loader, read by cold-code) -( offset 14 ) 0 l,-t \ argv (set by Zortech loader, read by cold-code) +- rel-t \ boot.fth will store a jmp instruction to cold-code at this location, +- rel-t \ so that the Forth image can be executed by jumping to its beginning address. +- rel-t ( offset 0 ) 0 c,-t 0 l,-t +- rel-t +- rel-t \ This byte is unused +- rel-t ( offset 5 ) 0 c,-t +- rel-t +- rel-t \ (Historical) The Zortech loader will put a far pointer to EMACS at location 6 +- rel-t ( offset 6 ) 0 l,-t 0 w,-t +- rel-t +- rel-t \ boot.fth will store the address of cold-code at this location. +- rel-t \ The Zortech-based protected-mode loader reads this location to find the +- rel-t \ place to begin execution. Zortech's null-pointer detection prevents +- rel-t \ the use of location zero. +- rel-t ( offset c ) 0 l,-t +- rel-t +- rel-t \ These locations are used for the argc and argv values for the Zortech loader +- rel-t +- rel-t ( offset 10 ) 0 l,-t \ argc (set by Zortech loader, read by cold-code) +- rel-t ( offset 14 ) 0 l,-t \ argv (set by Zortech loader, read by cold-code) +- rel-t +- rel-t ( offset 18 ) 0 l,-t \ Address of entry point for executing from the wrapper +- rel-t ( offset 1c ) 0 l,-t \ Base address where last saved, or -1 for position-independent
-( offset 18 ) 0 l,-t \ padding -( offset 1c ) 0 l,-t \ padding \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \
Modified: cpu/x86/metarel.fth ============================================================================== --- cpu/x86/metarel.fth Fri Dec 2 02:04:52 2011 (r2718) +++ cpu/x86/metarel.fth Fri Dec 2 02:05:04 2011 (r2719) @@ -28,6 +28,12 @@ :-h meta-init-relocation ( -- ) relocation-map-t /relocation-map-t 0 fill ; + +only forth meta also forth also definitions +' meta-set-relocation-bit is set-relocation-bit-t +' meta-init-relocation is init-relocation-t +only forth also definitions + \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \
Copied and modified: cpu/x86/nullrel.fth (from r2718, cpu/x86/savefort.fth) ============================================================================== --- cpu/x86/savefort.fth Fri Dec 2 02:04:52 2011 (r2718, copy source) +++ cpu/x86/nullrel.fth Fri Dec 2 02:05:04 2011 (r2719) @@ -1,25 +1,17 @@ \ See license at end of file -hex +purpose: Null version of relocation table management
-only forth also definitions +defer set-relocation-bit ' noop is set-relocation-bit +defer clear-relocation-bits ' 2drop is clear-relocation-bits
-: $save-forth ( name$ -- ) - " sys-init-io" $find-name is init-io ( name$ ) - " sys-init" init-save - ['] noop is set-relocation-bit \ Turn off until relo map is allocated +: max-image ( -- #bytes ) memtop @ origin - ;
- origin h# 10 + 8 erase \ Clear #args,args argument locations - origin origin h# 1c + le-l! \ Set relocation base address - - \ Set user initialization table - up@ init-user-area origin + user-size move ( name$ ) - - origin here over - $save-image -; -only forth also definitions +: relocation-on ( -- ) ; +: init-relocation ( -- ) ; +: relocation-off ( -- ) ;
\ LICENSE_BEGIN -\ Copyright (c) 2006 FirmWorks +\ Copyright (c) 2011 FirmWorks \ \ Permission is hereby granted, free of charge, to any person obtaining \ a copy of this software and associated documentation files (the
Modified: cpu/x86/objsup.fth ============================================================================== --- cpu/x86/objsup.fth Fri Dec 2 02:04:52 2011 (r2718) +++ cpu/x86/objsup.fth Fri Dec 2 02:05:04 2011 (r2719) @@ -26,6 +26,7 @@ cx pop \ action# in cx ax pop \ object-acf in ax 0 [ax] bx mov \ code address in bx ++ rel up bx add -4 [bx] cx cmp \ Test action number > if \ "true" branch is error cx push \ Push action# @@ -37,7 +38,8 @@ 4 # ax add \ Push object-apf ax push cx neg \ Index backwards into action table - -4 [bx] [cx] *4 push \ Push action-adr +- rel -4 [bx] [cx] *4 push \ Push action-adr ++ rel -4 [bx] [cx] *4 ax mov up ax add ax push \ Push action-adr ax ax xor \ Return false for no error 1push c; @@ -48,15 +50,19 @@ 4 [ax] cx mov \ Action# in cx
ax lods \ Object acf in ax ++ rel up ax add 4 # ax add \ Compute pfa ax push \ and push it
-4 [ax] ax mov \ Token of default action ++ rel up ax add
cx neg \ Index backwards into action table -4 [ax] [cx] *4 ax mov \ Address of action code ++ rel up ax add
- 0 [ax] jmp \ Tail of "NEXT" +- rel 0 [ax] jmp \ Tail of "NEXT" ++ rel 0 [ax] bx mov up bx add bx jmp \ Tail of "NEXT" end-code : >action# ( apf -- action# ) @ ;
Modified: cpu/x86/saveexp.fth ============================================================================== --- cpu/x86/saveexp.fth Fri Dec 2 02:04:52 2011 (r2718) +++ cpu/x86/saveexp.fth Fri Dec 2 02:05:04 2011 (r2719) @@ -55,11 +55,24 @@ $new-file
exp-header /exp-header ofd @ fputs + +\ The dictionary pointer is kept in absolute form at runtime, but must +\ be stored in relative form in the image file for the relative version. +\ The absolute version relocates it via the bitmap. The relative version +\ relocates it with explicit code in cold-code. ++ rel-t dp @ origin - dp ! ++ rel dp @ origin - dp ! code-adr code-size ofd @ fputs ++ rel dp @ origin + dp ! ++ rel-t dp @ origin + dp ! + +[ifdef] relocation-map relocation-map code-size h# 0f + 4 >> ofd @ fputs +[then] ofd @ fclose ; + \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \
Modified: cpu/x86/savefort.fth ============================================================================== --- cpu/x86/savefort.fth Fri Dec 2 02:04:52 2011 (r2718) +++ cpu/x86/savefort.fth Fri Dec 2 02:05:04 2011 (r2719) @@ -14,7 +14,9 @@ \ Set user initialization table up@ init-user-area origin + user-size move ( name$ )
- origin here over - $save-image + origin ++ rel h# 20 - + here over - $save-image ; only forth also definitions
Modified: cpu/x86/savemeta.fth ============================================================================== --- cpu/x86/savemeta.fth Fri Dec 2 02:04:52 2011 (r2718) +++ cpu/x86/savemeta.fth Fri Dec 2 02:05:04 2011 (r2719) @@ -3,15 +3,16 @@ hex
only forth also meta also forth-h definitions -: reloc-size ( -- n ) - here-t origin-t - ( user-size-t + ) - 0f + 4 >> -; +- rel-t : reloc-size ( -- n ) +- rel-t here-t origin-t - ( user-size-t + ) +- rel-t 0f + 4 >> +- rel-t ;
: $save-meta ( filename$ -- ) \ origin-t >hostaddr here-t origin-t - save-image
- origin-t origin-t h# 1c + le-l!-t \ Relocation base of saved image +- rel-t origin-t origin-t h# 1c + le-l!-t \ Relocation base of sav ++ rel-t -1 jmp-header h# 1c + le-l! \ Relocation base of saved image
here-t origin-t - is code-size origin-t >hostaddr is code-adr @@ -19,8 +20,9 @@
$new-file exp-header /exp-header ofd @ fputs ++ rel-t jmp-header /jmp-header ofd @ fputs code-adr code-size ofd @ fputs - relocation-map-t reloc-size ofd @ fputs +- rel-t relocation-map-t reloc-size ofd @ fputs
ofd @ fclose ;
Modified: cpu/x86/syscall.fth ============================================================================== --- cpu/x86/syscall.fth Fri Dec 2 02:04:52 2011 (r2718) +++ cpu/x86/syscall.fth Fri Dec 2 02:05:04 2011 (r2719) @@ -48,9 +48,11 @@ 18 [bx] gs mov \ his GS 0c [bx] ds mov \ his DS
- here-t 5 + #) call here-t origin-t - ( offset ) - dx pop - ( offset ) # dx sub ++ rel-t h# -20 [up] dx lea + +- rel-t here-t 5 + #) call here-t origin-t - ( offset ) +- rel-t dx pop +- rel-t ( offset ) # dx sub
1 # 'user flat? test 0<> if 6 [dx] call \ cs = 0, forth was called from windows or unix @@ -84,10 +86,7 @@ defer wrapper-vectors ' noop is wrapper-vectors defer forth-vectors ' noop is forth-vectors
-: wrapper? ( -- flag ) origin 6 + le-l@ 0<> ; : wrapper-call ( arg call# -- ) - wrapper? 0= abort" Wrapper calls are not available" - wrapper-vectors memtop @ (wrapper-call) forth-vectors
Modified: cpu/x86/target.fth ============================================================================== --- cpu/x86/target.fth Fri Dec 2 02:04:52 2011 (r2718) +++ cpu/x86/target.fth Fri Dec 2 02:05:04 2011 (r2719) @@ -3,8 +3,8 @@
only forth also definitions
-defer init-relocation-t -defer set-relocation-bit-t +defer init-relocation-t ' noop is init-relocation-t +defer set-relocation-bit-t ' noop is set-relocation-bit-t
decimal
@@ -114,14 +114,17 @@ le-l@-t [else] \t32-t l@-t ++ rel-t origin-t + [then] ; : a!-t ( token target-address -- ) set-relocation-bit-t \t16-t swap origin-t - tshift-t >> swap w!-t ++ rel-t origin-t - [ifdef] big-endian-t le-l!-t [else] ++ rel-t swap origin-t - swap \t32-t l!-t [then] ; @@ -154,6 +157,7 @@ le@ [else] \t32-t l-t@ ++ rel-t origin-t + [then] ; : a-t! ( target-address host-address -- ) @@ -161,6 +165,7 @@ [ifdef] big-endian-t le! [else] ++ rel-t swap origin-t - swap \t32-t l-t! [then] ; @@ -170,6 +175,7 @@ le@ [else] \t32-t l-t@ ++ rel-t origin-t + [then] ; : rlink-t! ( target-adr host-adr -- ) @@ -177,6 +183,7 @@ [ifdef] big-endian-t le! [else] ++ rel-t origin-t - \t32-t l-t! [then] ; @@ -252,6 +259,7 @@ #align-t constant #acf-align-t
\t16-t 1 tshift-t << constant #linkalign-t ++ rel-t 1 constant #linkalign-t \t32-t 1 constant #linkalign-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 ;
Modified: cpu/x86/tools.bth ============================================================================== --- cpu/x86/tools.bth Fri Dec 2 02:04:52 2011 (r2718) +++ cpu/x86/tools.bth Fri Dec 2 02:05:04 2011 (r2719) @@ -42,8 +42,8 @@ tag-file @ fclose tag-file off
' noop is include-hook ' noop is include-exit-hook -.( --- Saving tools.dic --- ) " tools.dic" $save-forth cr - +- rel .( --- Saving tools.dic --- ) " tools.dic" $save-forth cr ++ rel .( --- Saving toolsrel.dic --- ) " toolsrel.dic" $save-forth cr
[then] \ LICENSE_BEGIN
Added: cpu/x86/toolsrel.bth ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ cpu/x86/toolsrel.bth Fri Dec 2 02:05:04 2011 (r2719) @@ -0,0 +1,8 @@ +\ See license at end of file +purpose: Load file for Forth toolkit, without firmware + +dictionary: ${BP}/cpu/x86/build/kernelrel.dic +command: &x86forth &dictionary &this +build-now + +fload ${BP}/cpu/x86/tools.bth
Modified: forth/kernel/kernel.fth ============================================================================== --- forth/kernel/kernel.fth Fri Dec 2 02:04:52 2011 (r2718) +++ forth/kernel/kernel.fth Fri Dec 2 02:05:04 2011 (r2719) @@ -726,6 +726,9 @@ : ?comp (s -- ) state @ 0= ( -14 ) abort" Compilation Only " ; : ?exec (s -- ) state @ ( -29 ) abort" Execution Only " ;
+: defined? ( "name" -- flag ) + safe-parse-word $find dup if nip else nip nip then +; : $defined (s -- adr len 0 | xt +-1 ) safe-parse-word $find ; : $?missing ( +-1 | adr len 0 -- +-1 ) dup 0= if drop .not-found ( -13 ) abort then
Modified: forth/lib/brackif.fth ============================================================================== --- forth/lib/brackif.fth Fri Dec 2 02:04:52 2011 (r2718) +++ forth/lib/brackif.fth Fri Dec 2 02:05:04 2011 (r2719) @@ -30,13 +30,13 @@
: [then] ( -- ) ; immediate
-: [ifdef] ( "name" -- ) - $defined nip dup 0= if nip then postpone [if] -; immediate +: [ifdef] ( "name" -- ) defined? postpone [if] ; immediate +: [ifndef] ( "name" -- ) defined? 0= postpone [if] ; immediate + +: + ( "name" "rest of line" -- ) defined? 0= if postpone \ then ; immediate +: - ( "name" "rest of line" -- ) defined? if postpone \ then ; immediate +
-: [ifndef] ( "name" -- ) - $defined nip 0= dup if nip then postpone [if] -; immediate \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \
Modified: forth/wrapper/wrapper.c ============================================================================== --- forth/wrapper/wrapper.c Fri Dec 2 02:04:52 2011 (r2718) +++ forth/wrapper/wrapper.c Fri Dec 2 02:05:04 2011 (r2719) @@ -958,18 +958,21 @@ } f_close(f); - code_size = ( (int)header.size_blocks -2)*0x200 - + (int)header.size_fragment ; - code_wsize = (code_size+1) /2 ; old_org = *(int*)(&loadaddr[0x1c]); - delta_org = (int)loadaddr - old_org ; - reloc_table = &loadaddr[code_size] ; - for(i=0 ; i<code_wsize ; i++) { - if(bittest(reloc_table, i)) { - *(int*)(&loadaddr[2*i]) += delta_org ; + if (old_org != -1) { + /* Otherwise relocate lots of things via the bitmap */ + code_size = ( (int)header.size_blocks -2)*0x200 + + (int)header.size_fragment ; + code_wsize = (code_size+1) /2 ; + delta_org = (int)loadaddr - old_org ; + reloc_table = &loadaddr[code_size] ; + for(i=0 ; i<code_wsize ; i++) { + if(bittest(reloc_table, i)) { + *(int*)(&loadaddr[2*i]) += delta_org ; + } } + memcpy(&loadaddr[dictsize], reloc_table, (code_size+15)/16); } - memcpy(&loadaddr[dictsize], reloc_table, (code_size+15)/16);
#else
@@ -1079,6 +1082,8 @@ int (*codep)(); /* There is a pointer to the startup code at offset 0x18 */ codep = (int (*)()) *(int *)(&loadaddr[0x18]); + if (old_org == -1) + codep = (int (*)())((int)codep + (int)loadaddr); *(void **)(loadaddr+0x6) = fsyscall; *(short *)(&loadaddr[0x0a]) = 0; *(long *)(&loadaddr[0x10]) = argc;