From 6dfce7d4e790ce3859f86308e1a7097f11ce206c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Nov 2008 22:30:29 -0600 Subject: [PATCH] load-locals is a primitive now, change semantics of get-locals to bum out 2 instructions from the sub-primitive --- basis/cpu/ppc/bootstrap.factor | 4 +-- basis/cpu/x86/bootstrap.factor | 4 +-- basis/locals/backend/backend-tests.factor | 31 ++----------------- basis/locals/backend/backend.factor | 5 +-- basis/locals/locals.factor | 14 ++++----- .../known-words/known-words.factor | 6 ++-- core/bootstrap/primitives.factor | 1 + vm/primitives.c | 1 + vm/run.c | 8 +++++ vm/run.h | 1 + vm/types.c | 10 ++---- 11 files changed, 28 insertions(+), 57 deletions(-) diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor index 047d27c5f4..6b1a1014ee 100644 --- a/basis/cpu/ppc/bootstrap.factor +++ b/basis/cpu/ppc/bootstrap.factor @@ -406,9 +406,7 @@ big-endian on [ 3 ds-reg 0 LWZ 3 3 1 SRAWI - 4 4 LI - 4 3 4 SUBF - rs-reg 3 4 LWZX + rs-reg 3 3 LWZX 3 ds-reg 0 STW ] f f f \ get-local define-sub-primitive diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor index d5fc64de00..3272015848 100644 --- a/basis/cpu/x86/bootstrap.factor +++ b/basis/cpu/x86/bootstrap.factor @@ -382,9 +382,7 @@ big-endian off [ arg0 ds-reg [] MOV ! load local number fixnum>slot@ ! turn local number into offset - arg1 bootstrap-cell MOV ! load base - arg1 arg0 SUB ! turn it into a stack offset - arg0 rs-reg arg1 [+] MOV ! load local value + arg0 rs-reg arg0 [+] MOV ! load local value ds-reg [] arg0 MOV ! push to stack ] f f f \ get-local define-sub-primitive diff --git a/basis/locals/backend/backend-tests.factor b/basis/locals/backend/backend-tests.factor index 9352714509..ee714f7ef7 100644 --- a/basis/locals/backend/backend-tests.factor +++ b/basis/locals/backend/backend-tests.factor @@ -1,39 +1,14 @@ IN: locals.backend.tests USING: tools.test locals.backend kernel arrays ; -[ 3 ] [ 3 >r 1 get-local r> drop ] unit-test - -[ 4 ] [ 3 4 >r >r 2 get-local 2 drop-locals ] unit-test - -: get-local-test-1 ( -- x ) 3 >r 1 get-local r> drop ; +: get-local-test-1 ( -- x ) 3 1 load-locals 0 get-local 1 drop-locals ; \ get-local-test-1 must-infer [ 3 ] [ get-local-test-1 ] unit-test -: get-local-test-2 ( -- x ) 3 4 >r >r 2 get-local 2 drop-locals ; +: get-local-test-2 ( -- x ) 3 4 2 load-locals -1 get-local 2 drop-locals ; \ get-local-test-2 must-infer -[ 4 ] [ get-local-test-2 ] unit-test - -: get-local-test-3 ( -- a b ) 3 4 >r >r 2 get-local r> r> 2array ; - -\ get-local-test-3 must-infer - -[ 4 { 3 4 } ] [ get-local-test-3 ] unit-test - -: get-local-test-4 ( -- a b ) - 3 4 >r >r r> r> dup swap >r swap >r r> r> 2array ; - -\ get-local-test-4 must-infer - -[ 4 { 3 4 } ] [ get-local-test-4 ] unit-test - -[ 1 2 ] [ 1 2 2 load-locals r> r> ] unit-test - -: load-locals-test-1 ( -- a b ) 1 2 2 load-locals r> r> ; - -\ load-locals-test-1 must-infer - -[ 1 2 ] [ load-locals-test-1 ] unit-test +[ 3 ] [ get-local-test-2 ] unit-test diff --git a/basis/locals/backend/backend.factor b/basis/locals/backend/backend.factor index 0d9ee6a64e..ece5c1d200 100644 --- a/basis/locals/backend/backend.factor +++ b/basis/locals/backend/backend.factor @@ -1,11 +1,8 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: math.private kernel slots.private sequences effects words ; +USING: slots.private ; IN: locals.backend -: load-locals ( n -- ) - dup 0 eq? [ drop ] [ swap >r 1 fixnum-fast load-locals ] if ; - : local-value 2 slot ; inline : set-local-value 2 set-slot ; inline diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor index ccc13acf91..d2b057953c 100644 --- a/basis/locals/locals.factor +++ b/basis/locals/locals.factor @@ -103,7 +103,7 @@ C: quote [ dup quote? [ local>> ] when eq? ] with find drop ; : read-local-quot ( obj args -- quot ) - local-index 1+ [ get-local ] curry ; + local-index neg [ get-local ] curry ; GENERIC# localize 1 ( obj args -- quot ) @@ -139,19 +139,17 @@ UNION: special local quote local-word local-reader local-writer ; : point-free-end ( quot args -- newquot ) over peek special? [ dup drop-locals-quot [ [ peek ] dip localize ] dip append ] - [ dup drop-locals-quot nip swap peek suffix ] + [ drop-locals-quot swap peek suffix ] if ; : (point-free) ( quot args -- newquot ) [ nip load-locals-quot ] - [ point-free-body ] - [ point-free-end ] - 2tri 3append >quotation ; + [ reverse point-free-body ] + [ reverse point-free-end ] + 2tri [ ] 3append-as ; : point-free ( quot args -- newquot ) - over empty? - [ nip length \ drop >quotation ] - [ (point-free) ] if ; + over empty? [ nip length '[ _ ndrop ] ] [ (point-free) ] if ; UNION: lexical local local-reader local-writer local-word ; diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 09fce257bb..2b5cf8eb52 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -134,11 +134,11 @@ M: object infer-call* : infer-load-locals ( -- ) pop-literal nip - consume-d dup reverse copy-values dup output-r - [ [ f f ] dip ] [ reverse swap zip ] 2bi #shuffle, ; + consume-d dup copy-values dup output-r + [ [ f f ] dip ] [ swap zip ] 2bi #shuffle, ; : infer-get-local ( -- ) - [let* | n [ pop-literal nip ] + [let* | n [ pop-literal nip 1 swap - ] in-r [ n consume-r ] out-d [ in-r first copy-value 1array ] out-r [ in-r copy-values ] | diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 4624963aa6..84c79a340a 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -534,6 +534,7 @@ tuple { "unimplemented" "kernel.private" } { "gc-reset" "memory" } { "jit-compile" "quotations" } + { "load-locals" "locals.backend" } } [ [ first2 ] dip make-primitive ] each-index diff --git a/vm/primitives.c b/vm/primitives.c index a34d695bb8..135d5478ea 100755 --- a/vm/primitives.c +++ b/vm/primitives.c @@ -141,4 +141,5 @@ void *primitives[] = { primitive_unimplemented, primitive_gc_reset, primitive_jit_compile, + primitive_load_locals, }; diff --git a/vm/run.c b/vm/run.c index a28a956f29..c7002eb0ec 100755 --- a/vm/run.c +++ b/vm/run.c @@ -190,3 +190,11 @@ void primitive_set_slot(void) CELL value = dpop(); set_slot(obj,slot,value); } + +void primitive_load_locals(void) +{ + F_FIXNUM count = untag_fixnum_fast(dpop()); + memcpy((CELL *)(rs + CELLS),(CELL *)(ds - CELLS * (count - 1)),CELLS * count); + ds -= CELLS * count; + rs += CELLS * count; +} diff --git a/vm/run.h b/vm/run.h index f156ba3f03..06b6317015 100755 --- a/vm/run.h +++ b/vm/run.h @@ -247,5 +247,6 @@ void primitive_set_os_envs(void); void primitive_micros(void); void primitive_sleep(void); void primitive_set_slot(void); +void primitive_load_locals(void); bool stage2; diff --git a/vm/types.c b/vm/types.c index f1588465a4..a1175b320a 100755 --- a/vm/types.c +++ b/vm/types.c @@ -331,15 +331,9 @@ void primitive_tuple_boa(void) { F_TUPLE_LAYOUT *layout = untag_object(dpop()); F_FIXNUM size = untag_fixnum_fast(layout->size); - - REGISTER_UNTAGGED(layout); F_TUPLE *tuple = allot_tuple(layout); - UNREGISTER_UNTAGGED(layout); - - F_FIXNUM i; - for(i = size - 1; i >= 0; i--) - put(AREF(tuple,i),dpop()); - + memcpy(tuple + 1,(CELL *)(ds - CELLS * (size - 1)),CELLS * size); + ds -= CELLS * size; dpush(tag_tuple(tuple)); }