From 931b5322fc2b95c6e646aa0fd4a9e32e8d5b9504 Mon Sep 17 00:00:00 2001 From: slava Date: Sat, 22 Sep 2007 02:22:38 -0400 Subject: [PATCH 01/11] Factory load fixes --- extra/factory/.factory-menus.swp | Bin 0 -> 20480 bytes extra/factory/factory-menus | 3 ++- extra/factory/factory-rc | 1 + 3 files changed, 3 insertions(+), 1 deletion(-) create mode 100644 extra/factory/.factory-menus.swp diff --git a/extra/factory/.factory-menus.swp b/extra/factory/.factory-menus.swp new file mode 100644 index 0000000000000000000000000000000000000000..241afbf9d743d8df82d29f4298157ebb10de6d4e GIT binary patch literal 20480 zcmeI4YiJ!=9l(!Co8&f4u55L6h1HY0VAJX(?N;rYZ9^m5m)%xqwxJMKoy?uwJKlL* zXXfT6?Y4dp5yS_ILYGxPi4RbGASfuV_(4CYsH}*(=qFJT1y{uf3i>-|=04KQP17YG zRL+H8Zsxqt|2*dW|L32q99cSlQ68T;BKW*eh~}67a;EaGN5s_qLL|PuW~=Z!e5&q> zXNPx4MD$Hv;OwgHq)|NUuBWk`KWucqt-uXi$(@TbDU1Y+1nx!xt#s9TXhIx0`rt7+ zRe9i^16S@Qw@GUxU?gB9U?gB9U?gB9U?gB9U?lK=Ac1BohQ+^iM~3*h7haIFhi?}~ z^5ehkmR zr{FqV04c=&e*tm(Z-E032r>R^Al-NbuY;GteM0Q}A^ZTIhHt?8;JrYd`^rL;z74dq zbX173U%_{Pu(2EP1O(v2NjL%b2r>E#_&Ct!QR*1^DSREi1~I%H=>N!D;MMRd%p{b( z_eVh8d)MG9+z(?y>_KLGJ_}F5Yk>X?e-1tX?}yXy2s{Y1bBO*A{S%PE&?n#~EW>el zEl|eLOWjeR8lU> zI1B8hx@fOw`Ig)`^&H!;kSfRnt+hN*r@yWm*Gb>2yf3{@c3UUIC?!Scwyk!c`z`1D zr9hT;-NnmA3%x&PH|2gqW+fL3UWsv8R-CGwO`OQO6kXPhXQt45BcW>8kpLHWvxOg0$NKvv_Z z*%N=SxQci_&G3C$Pt)eyZ0_mfL{)btifcQq*Y~q}WkK`qRw(VdohA&ld_wwelBiD8 zC+1An$xignJ32^ck1-ftX#0{?+BZ(S(36>5jM9o*;Yr_P#6majb|jw<(`mYKs3P=w z$b!_O*>3)H%Pr_qzFzXFIdHjTYo}nf=!o52EP?I$gO&>8xzTDhJhcJP>4r+nhLNUq zw>{JLe1vu?upPAu2G9Dawc@*umReSTQ;)r5rmDkFWnYvq6J8rwh8x$iJ*e9Vven4s zyMY~^s;PEu+X(G7x2YF8+A;a?o>dSPO{Bh=$rpKspETYnCh)^nl)r)(zGI`M{KRecHkZwyc?dy zNimnsmcnYp?XZ|LEw;66dTuEuup6$mN`kC0YRH%_)omK}s2$hTTam1rw?ly?I9U!gqH{+0Ev5GiovA z1$oAc-PLG4AH`;aeMPQjVMSfkuNj^3s@tq@#44W}uqcFvMXI*j`uD*}8?jrnInU~;Zg-vrroV78-)Q?@QUzVo z3+Z&Wg!0kXv%aWY(Kl}kR#7*0^CId7@8%ksyG?bF(^9JtQn`6Ej`EO9+ICaU&u762 zZ`ZJ4wPV5_7J}@30n>fCs;#CxVM){g$4Znoae~6o8Pu=(;Hq=?ALgf3b-LO^@ox4mjwR}Gkw=Ul(Z!KzIJiqF(tD_DA^$^2Bmq2BXq7f-qY zeq>jvDNnY}!K7Mq(`2R{%;?5$3TcG_!{k=8tvB17#FfSKm(I?~h8u^jFI%CvF4ych zkwFx*@yf(UJ+vK%gKiY-E?9>&sHxa}$+w84Y=>5?z!z8vvE3`{|5BZlc`Uzy&OZ zx_$JdYfvdFeBJRQM_H6eSjirWOgY(1$W4qo?KZYWZ6nebfPGD-?WzVnG6i;}T>lr` zOAn#XYyBUef35$c*O&hUp8<6K@{@22mViGVF25AGm!A9?D7ygn+mnNzc z;P>z>;L|XI55mYNLEZg73e>&#Id}$c!8_q39E5wh>;F8^pFPvC4@%tee-oYty@CBfZp%1|a;T)U=+V Date: Sat, 22 Sep 2007 02:27:28 -0400 Subject: [PATCH 02/11] JSON writer fix --- extra/json/writer/writer.factor | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/extra/json/writer/writer.factor b/extra/json/writer/writer.factor index fc11904890..4370a38411 100644 --- a/extra/json/writer/writer.factor +++ b/extra/json/writer/writer.factor @@ -21,6 +21,11 @@ M: string json-print ( obj -- ) M: number json-print ( num -- ) number>string write ; +! sequence and number overlap, we provide an explicit +! disambiguation method +M: integer json-print ( num -- ) + number>string write ; + M: sequence json-print ( array -- string ) CHAR: [ write1 [ >json ] map "," join write CHAR: ] write1 ; From 2589c69c04d02063bc44036163eae5bae04d95ff Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 22 Sep 2007 02:27:53 -0400 Subject: [PATCH 03/11] Unix launcher: use execvp instead of execve --- extra/io/unix/launcher/launcher.factor | 7 +++---- extra/unix/unix.factor | 1 + 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index c3fe6d0a05..7b286feae1 100644 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -9,16 +9,15 @@ USE: unix : with-fork ( quot -- pid ) fork [ zero? -rot if ] keep ; inline -: prepare-execve ( args -- cmd args envp ) +: prepare-execvp ( args -- cmd args ) #! Doesn't free any memory, so we only call this word #! after forking. [ malloc-char-string ] map [ first ] keep - f add >c-void*-array - f ; + f add >c-void*-array ; : (spawn-process) ( args -- ) - [ prepare-execve execve ] catch 1 exit ; + [ prepare-execvp execvp ] catch 1 exit ; : spawn-process ( args -- pid ) [ (spawn-process) ] [ drop ] with-fork ; diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index 8eb940352f..ca4b569587 100644 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -107,6 +107,7 @@ FUNCTION: void close ( int fd ) ; FUNCTION: int connect ( int s, void* name, socklen_t namelen ) ; FUNCTION: int dup2 ( int oldd, int newd ) ; ! FUNCTION: int dup ( int oldd ) ; +FUNCTION: int execvp ( char* path, char** argv ) ; FUNCTION: int execve ( char* path, char** argv, char** envp ) ; FUNCTION: int fchdir ( int fd ) ; FUNCTION: int fchmod ( int fd, mode_t mode ) ; From 136e249f6d018707701a8b7152f940f863529ceb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 22 Sep 2007 02:28:49 -0400 Subject: [PATCH 04/11] x86-64 fixes --- core/bootstrap/image/image.factor | 2 +- core/cpu/x86/32/bootstrap.factor | 1 + core/cpu/x86/64/64.factor | 2 ++ core/cpu/x86/64/bootstrap.factor | 1 + core/cpu/x86/bootstrap.factor | 2 +- vm/cpu-x86.32.S | 2 +- vm/cpu-x86.64.S | 2 +- 7 files changed, 8 insertions(+), 4 deletions(-) diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index 36d2f7f1de..0f61eb4c83 100644 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -32,7 +32,7 @@ IN: bootstrap.image : -1-offset 9 ; inline : array-start 2 bootstrap-cells object tag-number - ; -: scan@ array-start 4 - ; +: scan@ array-start bootstrap-cell - ; : wrapper@ bootstrap-cell object tag-number - ; : word-xt@ 8 bootstrap-cells object tag-number - ; : quot-array@ bootstrap-cell object tag-number - ; diff --git a/core/cpu/x86/32/bootstrap.factor b/core/cpu/x86/32/bootstrap.factor index 32d07797e7..289ae0c213 100644 --- a/core/cpu/x86/32/bootstrap.factor +++ b/core/cpu/x86/32/bootstrap.factor @@ -13,5 +13,6 @@ IN: bootstrap.x86 : scan-reg EBX ; : xt-reg ECX ; : fixnum>slot@ arg0 1 SAR ; +: next-frame@ -44 ; "resource:core/cpu/x86/bootstrap.factor" run-file diff --git a/core/cpu/x86/64/64.factor b/core/cpu/x86/64/64.factor index b91ab169de..94da29eb6d 100644 --- a/core/cpu/x86/64/64.factor +++ b/core/cpu/x86/64/64.factor @@ -13,6 +13,8 @@ PREDICATE: x86-backend amd64-backend M: amd64-backend ds-reg R14 ; M: amd64-backend rs-reg R15 ; M: amd64-backend stack-reg RSP ; +M: x86-backend xt-reg RCX ; +M: x86-backend stack-save-reg RSI ; M: temp-reg v>operand drop R13 ; diff --git a/core/cpu/x86/64/bootstrap.factor b/core/cpu/x86/64/bootstrap.factor index 9d3fa8849f..00db1ac119 100644 --- a/core/cpu/x86/64/bootstrap.factor +++ b/core/cpu/x86/64/bootstrap.factor @@ -13,5 +13,6 @@ IN: bootstrap.x86 : scan-reg RBX ; : xt-reg RCX ; : fixnum>slot@ ; +: next-frame@ -88 ; "resource:core/cpu/x86/bootstrap.factor" run-file diff --git a/core/cpu/x86/bootstrap.factor b/core/cpu/x86/bootstrap.factor index 84d0b152b8..67156d8300 100644 --- a/core/cpu/x86/bootstrap.factor +++ b/core/cpu/x86/bootstrap.factor @@ -17,7 +17,7 @@ big-endian off [ xt-reg PUSH ! save XT - xt-reg stack-reg -44 [+] LEA ! compute forward chain pointer + xt-reg stack-reg next-frame@ [+] LEA ! compute forward chain pointer xt-reg PUSH ! save forward chain pointer arg0 PUSH ! save array stack-reg 4 bootstrap-cells SUB ! reserve space for scan-save diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S index 93af51c968..19a735ec88 100644 --- a/vm/cpu-x86.32.S +++ b/vm/cpu-x86.32.S @@ -25,7 +25,7 @@ and the callstack top is passed in EDX */ #define WORD_DEF_OFFSET 13 #define WORD_XT_OFFSET 29 -/* We pass a function pointer to memcpy in 16(%esp) to work around a Mac OS X +/* We pass a function pointer to memcpy to work around a Mac OS X ABI limitation which would otherwise require us to do a bizzaro PC-relative trampoline to retrieve the function address */ DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *memcpy)): diff --git a/vm/cpu-x86.64.S b/vm/cpu-x86.64.S index 8aef5f9d61..1725c0cbd5 100644 --- a/vm/cpu-x86.64.S +++ b/vm/cpu-x86.64.S @@ -25,7 +25,7 @@ #define WORD_DEF_OFFSET 29 #define WORD_XT_OFFSET 61 -/* We pass a function pointer to memcpy in 16(%esp) to work around a Mac OS X +/* We pass a function pointer to memcpy to work around a Mac OS X ABI limitation which would otherwise require us to do a bizzaro PC-relative trampoline to retrieve the function address */ DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *memcpy)): From dacab19574f7d5126b474e1074773bc010fa3cd3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 22 Sep 2007 03:09:18 -0400 Subject: [PATCH 05/11] AMD64 fixes --- core/cpu/x86/32/32.factor | 4 ++-- core/cpu/x86/64/64.factor | 10 +++++----- core/cpu/x86/architecture/architecture.factor | 2 +- vm/cpu-x86.S | 2 +- vm/factor.c | 1 + vm/os-linux-x86-64.h | 2 ++ 6 files changed, 12 insertions(+), 9 deletions(-) create mode 100644 vm/os-linux-x86-64.h diff --git a/core/cpu/x86/32/32.factor b/core/cpu/x86/32/32.factor index 998e87c7a0..4ef7777dd4 100644 --- a/core/cpu/x86/32/32.factor +++ b/core/cpu/x86/32/32.factor @@ -206,10 +206,10 @@ M: x86-backend %box-small-struct ( size -- ) M: x86-backend %prepare-alien-indirect ( -- ) "unbox_alien" f %alien-invoke - ESP cell temp@ [+] EAX MOV ; + cell temp@ EAX MOV ; M: x86-backend %alien-indirect ( -- ) - ESP cell temp@ [+] CALL ; + cell temp@ CALL ; M: x86-backend %alien-callback ( quot -- ) 4 [ diff --git a/core/cpu/x86/64/64.factor b/core/cpu/x86/64/64.factor index 94da29eb6d..708c75e0bd 100644 --- a/core/cpu/x86/64/64.factor +++ b/core/cpu/x86/64/64.factor @@ -16,10 +16,10 @@ M: amd64-backend stack-reg RSP ; M: x86-backend xt-reg RCX ; M: x86-backend stack-save-reg RSI ; -M: temp-reg v>operand drop R13 ; +M: temp-reg v>operand drop RBX ; M: int-regs return-reg drop RAX ; -M: int-regs vregs drop { RAX RBX RCX RDX RBP RSI RDI R8 R9 R10 R11 R12 } ; +M: int-regs vregs drop { RAX RCX RDX RBP RSI RDI R8 R9 R10 R11 R12 R13 } ; M: int-regs param-regs drop { RDI RSI RDX RCX R8 R9 } ; M: float-regs return-reg drop XMM0 ; @@ -146,17 +146,17 @@ M: amd64-backend %alien-indirect ( -- ) cell temp@ CALL ; M: amd64-backend %alien-callback ( quot -- ) - RDI load-indirect "run_callback" f compile-c-call ; + RDI load-indirect "c_to_factor" f compile-c-call ; M: amd64-backend %callback-value ( ctype -- ) ! Save top of data stack %prepare-unbox ! Put former top of data stack in RDI - temp@ RDI MOV + cell temp@ RDI MOV ! Restore data/call/retain stacks "unnest_stacks" f %alien-invoke ! Put former top of data stack in RDI - RDI temp@ MOV + RDI cell temp@ MOV ! Unbox former top of data stack to return registers unbox-return ; diff --git a/core/cpu/x86/architecture/architecture.factor b/core/cpu/x86/architecture/architecture.factor index 6879e23051..4acd4d8c46 100644 --- a/core/cpu/x86/architecture/architecture.factor +++ b/core/cpu/x86/architecture/architecture.factor @@ -150,7 +150,7 @@ M: x86-backend small-enough? ( n -- ? ) : %tag-fixnum ( reg -- ) tag-bits get SHL ; -: temp@ \ stack-frame get swap - ; +: temp@ stack-reg \ stack-frame get rot - [+] ; : struct-return@ ( size n -- n ) [ diff --git a/vm/cpu-x86.S b/vm/cpu-x86.S index a84ae6c480..3e2a97dd5c 100644 --- a/vm/cpu-x86.S +++ b/vm/cpu-x86.S @@ -29,7 +29,7 @@ DEF(FASTCALL void,dosym,(CELL word)): /* Here we have two entry points. The first one is taken when profiling is enabled */ DEF(FASTCALL void,docol_profiling,(CELL word)): - add $CELL_SIZE,PROFILING_OFFSET(%eax) /* Increment profile-count slot */ + add $CELL_SIZE,PROFILING_OFFSET(ARG0) /* Increment profile-count slot */ DEF(FASTCALL void,docol,(CELL word)): mov WORD_DEF_OFFSET(ARG0),ARG0 /* Load word-def slot */ JUMP_QUOT diff --git a/vm/factor.c b/vm/factor.c index e74662a8a4..6a6dc8f154 100644 --- a/vm/factor.c +++ b/vm/factor.c @@ -135,6 +135,7 @@ void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded } nest_stacks(); + printf("%lx\n",untag_quotation(userenv[BOOT_ENV])->xt); c_to_factor_toplevel(userenv[BOOT_ENV]); unnest_stacks(); diff --git a/vm/os-linux-x86-64.h b/vm/os-linux-x86-64.h new file mode 100644 index 0000000000..2bbae86f6e --- /dev/null +++ b/vm/os-linux-x86-64.h @@ -0,0 +1,2 @@ +#define UAP_PROGRAM_COUNTER(ucontext) \ + (((ucontext_t *)(ucontext))->uc_mcontext.gregs[16]) From 34465cf837252e350e3f20b50934997318ee9215 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 22 Sep 2007 03:26:09 -0400 Subject: [PATCH 06/11] Remove debug message --- vm/factor.c | 1 - 1 file changed, 1 deletion(-) diff --git a/vm/factor.c b/vm/factor.c index 6a6dc8f154..e74662a8a4 100644 --- a/vm/factor.c +++ b/vm/factor.c @@ -135,7 +135,6 @@ void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded } nest_stacks(); - printf("%lx\n",untag_quotation(userenv[BOOT_ENV])->xt); c_to_factor_toplevel(userenv[BOOT_ENV]); unnest_stacks(); From 77d8a844f3763be44dc86cad2d6d1188b95429c4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 22 Sep 2007 04:00:22 -0400 Subject: [PATCH 07/11] Untested Linux/x86 support --- vm/os-linux-x86-32.h | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 vm/os-linux-x86-32.h diff --git a/vm/os-linux-x86-32.h b/vm/os-linux-x86-32.h new file mode 100644 index 0000000000..e12133966d --- /dev/null +++ b/vm/os-linux-x86-32.h @@ -0,0 +1,2 @@ +#define UAP_PROGRAM_COUNTER(ucontext) \ + (((ucontext_t *)(ucontext))->uc_mcontext.gregs[14]) From 05e66a0659db86c90721344ea8c6b7e468598408 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 22 Sep 2007 17:17:37 -0400 Subject: [PATCH 08/11] Remove dead code; code_fixup stack frame return addrs --- vm/image.c | 21 ++++++--------------- 1 file changed, 6 insertions(+), 15 deletions(-) diff --git a/vm/image.c b/vm/image.c index 0d1b22adee..2d3318472d 100644 --- a/vm/image.c +++ b/vm/image.c @@ -81,19 +81,6 @@ void load_image(F_PARAMETERS *p) userenv[IMAGE_ENV] = tag_object(from_native_string(p->image)); } -/* Compute total sum of sizes of free blocks */ -void save_code_heap(FILE *file) -{ - F_BLOCK *scan = first_block(&code_heap); - - while(scan) - { - if(scan->status == B_ALLOCATED) - fwrite(scan,scan->size,1,file); - scan = next_block(&code_heap,scan); - } -} - /* Save the current image to disk */ bool save_image(const F_CHAR *filename) { @@ -132,7 +119,6 @@ bool save_image(const F_CHAR *filename) fwrite(&h,sizeof(F_HEADER),1,file); fwrite((void*)tenured->start,h.data_size,1,file); - /* save_code_heap(file); */ fwrite(first_block(&code_heap),h.code_size,1,file); fclose(file); @@ -198,7 +184,12 @@ void fixup_stack_frame(F_STACK_FRAME *frame) frame->scan = scan + frame->array; } - /* code_fixup(&frame->return_address); */ +#ifdef CALLSTACK_UP_P + printf("%x %x\n",frame->xt,*(CELL *)(frame->next + 1)); + code_fixup((CELL *)(frame->next + 1)); +#else + code_fixup(&frame->return_address); +#endif } /* Initialize an object in a newly-loaded image */ From 64e3e0c0d69ee8fe4ac211fa491d2994a4959643 Mon Sep 17 00:00:00 2001 From: Slava Date: Sat, 22 Sep 2007 18:56:27 -0400 Subject: [PATCH 09/11] Fix callstack relocation --- extra/factory/.factory-menus.swp | Bin 20480 -> 0 bytes vm/image.c | 19 ++++++++++++++----- vm/stack.c | 4 ++-- vm/stack.h | 2 ++ 4 files changed, 18 insertions(+), 7 deletions(-) delete mode 100644 extra/factory/.factory-menus.swp diff --git a/extra/factory/.factory-menus.swp b/extra/factory/.factory-menus.swp deleted file mode 100644 index 241afbf9d743d8df82d29f4298157ebb10de6d4e..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 20480 zcmeI4YiJ!=9l(!Co8&f4u55L6h1HY0VAJX(?N;rYZ9^m5m)%xqwxJMKoy?uwJKlL* zXXfT6?Y4dp5yS_ILYGxPi4RbGASfuV_(4CYsH}*(=qFJT1y{uf3i>-|=04KQP17YG zRL+H8Zsxqt|2*dW|L32q99cSlQ68T;BKW*eh~}67a;EaGN5s_qLL|PuW~=Z!e5&q> zXNPx4MD$Hv;OwgHq)|NUuBWk`KWucqt-uXi$(@TbDU1Y+1nx!xt#s9TXhIx0`rt7+ zRe9i^16S@Qw@GUxU?gB9U?gB9U?gB9U?gB9U?lK=Ac1BohQ+^iM~3*h7haIFhi?}~ z^5ehkmR zr{FqV04c=&e*tm(Z-E032r>R^Al-NbuY;GteM0Q}A^ZTIhHt?8;JrYd`^rL;z74dq zbX173U%_{Pu(2EP1O(v2NjL%b2r>E#_&Ct!QR*1^DSREi1~I%H=>N!D;MMRd%p{b( z_eVh8d)MG9+z(?y>_KLGJ_}F5Yk>X?e-1tX?}yXy2s{Y1bBO*A{S%PE&?n#~EW>el zEl|eLOWjeR8lU> zI1B8hx@fOw`Ig)`^&H!;kSfRnt+hN*r@yWm*Gb>2yf3{@c3UUIC?!Scwyk!c`z`1D zr9hT;-NnmA3%x&PH|2gqW+fL3UWsv8R-CGwO`OQO6kXPhXQt45BcW>8kpLHWvxOg0$NKvv_Z z*%N=SxQci_&G3C$Pt)eyZ0_mfL{)btifcQq*Y~q}WkK`qRw(VdohA&ld_wwelBiD8 zC+1An$xignJ32^ck1-ftX#0{?+BZ(S(36>5jM9o*;Yr_P#6majb|jw<(`mYKs3P=w z$b!_O*>3)H%Pr_qzFzXFIdHjTYo}nf=!o52EP?I$gO&>8xzTDhJhcJP>4r+nhLNUq zw>{JLe1vu?upPAu2G9Dawc@*umReSTQ;)r5rmDkFWnYvq6J8rwh8x$iJ*e9Vven4s zyMY~^s;PEu+X(G7x2YF8+A;a?o>dSPO{Bh=$rpKspETYnCh)^nl)r)(zGI`M{KRecHkZwyc?dy zNimnsmcnYp?XZ|LEw;66dTuEuup6$mN`kC0YRH%_)omK}s2$hTTam1rw?ly?I9U!gqH{+0Ev5GiovA z1$oAc-PLG4AH`;aeMPQjVMSfkuNj^3s@tq@#44W}uqcFvMXI*j`uD*}8?jrnInU~;Zg-vrroV78-)Q?@QUzVo z3+Z&Wg!0kXv%aWY(Kl}kR#7*0^CId7@8%ksyG?bF(^9JtQn`6Ej`EO9+ICaU&u762 zZ`ZJ4wPV5_7J}@30n>fCs;#CxVM){g$4Znoae~6o8Pu=(;Hq=?ALgf3b-LO^@ox4mjwR}Gkw=Ul(Z!KzIJiqF(tD_DA^$^2Bmq2BXq7f-qY zeq>jvDNnY}!K7Mq(`2R{%;?5$3TcG_!{k=8tvB17#FfSKm(I?~h8u^jFI%CvF4ych zkwFx*@yf(UJ+vK%gKiY-E?9>&sHxa}$+w84Y=>5?z!z8vvE3`{|5BZlc`Uzy&OZ zx_$JdYfvdFeBJRQM_H6eSjirWOgY(1$W4qo?KZYWZ6nebfPGD-?WzVnG6i;}T>lr` zOAn#XYyBUef35$c*O&hUp8<6K@{@22mViGVF25AGm!A9?D7ygn+mnNzc z;P>z>;L|XI55mYNLEZg73e>&#Id}$c!8_q39E5wh>;F8^pFPvC4@%tee-oYty@CBfZp%1|a;T)U=+Vexpired = T; } +F_FIXNUM delta; + void fixup_stack_frame(F_STACK_FRAME *frame) { code_fixup(&frame->xt); @@ -185,13 +187,22 @@ void fixup_stack_frame(F_STACK_FRAME *frame) } #ifdef CALLSTACK_UP_P - printf("%x %x\n",frame->xt,*(CELL *)(frame->next + 1)); - code_fixup((CELL *)(frame->next + 1)); + F_STACK_FRAME *next = REBASE_FRAME_SUCCESSOR(frame,delta); + code_fixup((XT *)(next + 1)); #else code_fixup(&frame->return_address); #endif } +void fixup_callstack_object(F_CALLSTACK *stack) +{ + CELL top = (CELL)(stack + 1); + CELL bottom = top + untag_fixnum_fast(stack->length); + delta = (bottom - stack->bottom); + + iterate_callstack_object(stack,fixup_stack_frame); +} + /* Initialize an object in a newly-loaded image */ void relocate_object(CELL relocating) { @@ -212,9 +223,7 @@ void relocate_object(CELL relocating) fixup_alien((F_ALIEN *)relocating); break; case CALLSTACK_TYPE: - iterate_callstack_object( - (F_CALLSTACK *)relocating, - fixup_stack_frame); + fixup_callstack_object((F_CALLSTACK *)relocating); break; } } diff --git a/vm/stack.c b/vm/stack.c index e50575219c..cf3c1df00a 100644 --- a/vm/stack.c +++ b/vm/stack.c @@ -111,7 +111,7 @@ void iterate_callstack(CELL top, CELL bottom, CELL base, CALLSTACK_ITER iterator while(ITERATING_P) { - F_STACK_FRAME *next = (F_STACK_FRAME *)((CELL)FRAME_SUCCESSOR(frame) + delta); + F_STACK_FRAME *next = REBASE_FRAME_SUCCESSOR(frame,delta); iterator(frame); frame = next; } @@ -344,7 +344,7 @@ static F_FIXNUM delta; void adjust_stack_frame(F_STACK_FRAME *frame) { - FRAME_SUCCESSOR(frame) = (F_STACK_FRAME *)((CELL)FRAME_SUCCESSOR(frame) + delta); + FRAME_SUCCESSOR(frame) = REBASE_FRAME_SUCCESSOR(frame,delta); } void adjust_callstack(F_CALLSTACK *stack, CELL bottom) diff --git a/vm/stack.h b/vm/stack.h index d2bec4fef1..62ee1d9ba2 100644 --- a/vm/stack.h +++ b/vm/stack.h @@ -56,6 +56,8 @@ void init_stacks(CELL ds_size, CELL rs_size); #define FIRST_STACK_FRAME(stack) (F_STACK_FRAME *)((stack) + 1) +#define REBASE_FRAME_SUCCESSOR(frame,delta) (F_STACK_FRAME *)((CELL)FRAME_SUCCESSOR(frame) + delta) + typedef void (*CALLSTACK_ITER)(F_STACK_FRAME *frame); void iterate_callstack(CELL top, CELL bottom, CELL base, CALLSTACK_ITER iterator); From b0f931d038df45ddf75524835f6616a9a148b0a9 Mon Sep 17 00:00:00 2001 From: Slava Date: Sat, 22 Sep 2007 19:31:28 -0400 Subject: [PATCH 10/11] x86 alien fix and new slot intrinsics --- core/cpu/x86/architecture/architecture.factor | 2 +- core/cpu/x86/intrinsics/intrinsics.factor | 67 +++++++++---------- 2 files changed, 34 insertions(+), 35 deletions(-) diff --git a/core/cpu/x86/architecture/architecture.factor b/core/cpu/x86/architecture/architecture.factor index 4acd4d8c46..91e8bf1460 100644 --- a/core/cpu/x86/architecture/architecture.factor +++ b/core/cpu/x86/architecture/architecture.factor @@ -156,7 +156,7 @@ M: x86-backend small-enough? ( n -- ? ) [ stack-frame* cell + + ] [ - temp@ + \ stack-frame get swap - ] ?if ; HOOK: %unbox-struct-1 compiler-backend ( -- ) diff --git a/core/cpu/x86/intrinsics/intrinsics.factor b/core/cpu/x86/intrinsics/intrinsics.factor index fc4d7388bf..1ee6efecfc 100644 --- a/core/cpu/x86/intrinsics/intrinsics.factor +++ b/core/cpu/x86/intrinsics/intrinsics.factor @@ -71,29 +71,38 @@ IN: cpu.x86.intrinsics } define-intrinsic ! Slots +: %slot-literal-known-tag + "obj" operand + "n" get cells + "obj" operand-tag - [+] ; + +: %slot-literal-any-tag + "obj" operand %untag + "obj" operand "n" get cells [+] ; + +: %slot-any + "obj" operand %untag + "n" operand fixnum>slot@ + "obj" operand "n" operand [+] ; \ slot { + ! Slot number is literal and the tag is known + { + [ "obj" operand %slot-literal-known-tag MOV ] H{ + { +input+ { { f "obj" known-tag } { [ small-slot? ] "n" } } } + { +output+ { "obj" } } + } + } ! Slot number is literal { - [ - "obj" operand %untag - ! load slot value - "obj" operand dup "n" get cells [+] MOV - ] H{ + [ "obj" operand %slot-literal-any-tag MOV ] H{ { +input+ { { f "obj" } { [ small-slot? ] "n" } } } { +output+ { "obj" } } } } ! Slot number in a register { - [ - "obj" operand %untag - ! turn tagged fixnum slot # into an offset, - ! multiple of 4 - "n" operand fixnum>slot@ - ! load slot value - "obj" operand dup "n" operand [+] MOV - ] H{ + [ "obj" operand %slot-any MOV ] H{ { +input+ { { f "obj" } { f "n" } } } { +output+ { "obj" } } { +clobber+ { "n" } } @@ -105,38 +114,28 @@ IN: cpu.x86.intrinsics #! Mark the card pointed to by vreg. "val" operand-immediate? "obj" get fresh-object? or [ "obj" operand card-bits SHR - "scratch" operand HEX: ffffffff MOV - "cards_offset" f rc-absolute-cell rel-dlsym - "scratch" operand dup [] MOV - "scratch" operand "obj" operand [+] card-mark OR + "cards_offset" f %alien-global + temp-reg v>operand "obj" operand [+] card-mark OR ] unless ; \ set-slot { + ! Slot number is literal and the tag is known + { + [ %slot-literal-known-tag "val" operand MOV ] H{ + { +input+ { { f "val" } { f "obj" known-tag } { [ small-slot? ] "n" } } } + { +clobber+ { "obj" } } + } + } ! Slot number is literal { - [ - "obj" operand %untag - ! store new slot value - "obj" operand "n" get cells [+] "val" operand MOV - generate-write-barrier - ] H{ + [ %slot-literal-any-tag "val" operand MOV generate-write-barrier ] H{ { +input+ { { f "val" } { f "obj" } { [ small-slot? ] "n" } } } - { +scratch+ { { f "scratch" } } } { +clobber+ { "obj" } } } } ! Slot number in a register { - [ - ! turn tagged fixnum slot # into an offset - "n" operand fixnum>slot@ - "obj" operand %untag - ! store new slot value - "obj" operand "n" operand [+] "val" operand MOV - ! reuse register - "n" get "scratch" set - generate-write-barrier - ] H{ + [ %slot-any "val" operand MOV generate-write-barrier ] H{ { +input+ { { f "val" } { f "obj" } { f "n" } } } { +clobber+ { "obj" "n" } } } From 94bfbbde2fd87468c77cc0fdd928e7929018b29f Mon Sep 17 00:00:00 2001 From: Slava Date: Sun, 23 Sep 2007 15:26:15 -0400 Subject: [PATCH 11/11] Fix set-slot intrinsic for x86 --- core/cpu/x86/intrinsics/intrinsics.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/cpu/x86/intrinsics/intrinsics.factor b/core/cpu/x86/intrinsics/intrinsics.factor index 1ee6efecfc..0228848a33 100644 --- a/core/cpu/x86/intrinsics/intrinsics.factor +++ b/core/cpu/x86/intrinsics/intrinsics.factor @@ -121,7 +121,7 @@ IN: cpu.x86.intrinsics \ set-slot { ! Slot number is literal and the tag is known { - [ %slot-literal-known-tag "val" operand MOV ] H{ + [ %slot-literal-known-tag "val" operand MOV generate-write-barrier ] H{ { +input+ { { f "val" } { f "obj" known-tag } { [ small-slot? ] "n" } } } { +clobber+ { "obj" } } }