From: Joe Marshall Date: Wed, 17 Oct 2012 17:47:16 +0000 (-0700) Subject: Remove last remnants of SEQUENCE-3. Rename return code for sequence-2 to sequence... X-Git-Tag: release-9.2.0~212 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6f78ed99f899b9196948b16d3c05bde16aa32404;p=mit-scheme.git Remove last remnants of SEQUENCE-3. Rename return code for sequence-2 to sequence-continue. --- diff --git a/src/compiler/fggen/fggen.scm b/src/compiler/fggen/fggen.scm index 9ce8396e7..5b0393a6d 100644 --- a/src/compiler/fggen/fggen.scm +++ b/src/compiler/fggen/fggen.scm @@ -507,7 +507,7 @@ USA. (let ((first-action (generate/subproblem/effect block continuation context - (scode/sequence-immediate-first expression) 'SEQUENCE-2-SECOND + (scode/sequence-immediate-first expression) 'SEQUENCE-CONTINUE expression))) ((scfg*ctype->ctype! continuation) first-action diff --git a/src/microcode/gcloop.c b/src/microcode/gcloop.c index 96768474c..518e32508 100644 --- a/src/microcode/gcloop.c +++ b/src/microcode/gcloop.c @@ -1272,7 +1272,7 @@ gc_type_t gc_type_map [N_TYPE_CODES] = GC_VECTOR, /* TC_NON_MARKED_VECTOR */ GC_PAIR, /* TC_LAMBDA */ GC_NON_POINTER, /* TC_PRIMITIVE */ - GC_PAIR, /* TC_SEQUENCE_2 */ + GC_PAIR, /* TC_SEQUENCE */ GC_NON_POINTER, /* TC_FIXNUM */ GC_PAIR, /* TC_PCOMB1 */ GC_VECTOR, /* TC_CONTROL_POINT */ @@ -1298,7 +1298,7 @@ gc_type_t gc_type_map [N_TYPE_CODES] = GC_NON_POINTER, /* TC_PCOMB0 */ GC_VECTOR, /* TC_VECTOR_16B */ GC_SPECIAL, /* TC_REFERENCE_TRAP */ - GC_TRIPLE, /* TC_SEQUENCE_3 */ + GC_UNDEFINED, /* 0x33 */ GC_TRIPLE, /* TC_CONDITIONAL */ GC_PAIR, /* TC_DISJUNCTION */ GC_CELL, /* TC_CELL */ diff --git a/src/microcode/interp.c b/src/microcode/interp.c index b0591a28c..a8e5ddb60 100644 --- a/src/microcode/interp.c +++ b/src/microcode/interp.c @@ -555,15 +555,10 @@ Interpret (int pop_return_p) SET_VAL (MEMORY_REF (GET_EXP, SCODE_QUOTE_OBJECT)); break; - case TC_SEQUENCE_2: + case TC_SEQUENCE: Will_Push (CONTINUATION_SIZE + 1); PUSH_ENV (); - PUSH_NTH_THEN (RC_SEQ_2_DO_2, SEQUENCE_1); - - case TC_SEQUENCE_3: - Will_Push (CONTINUATION_SIZE + 1); - PUSH_ENV (); - PUSH_NTH_THEN (RC_SEQ_3_DO_2, SEQUENCE_1); + PUSH_NTH_THEN (RC_EXECUTE_SEQUENCE_FINISH, SEQUENCE_1); case TC_SYNTAX_ERROR: EVAL_ERROR (ERR_SYNTAX_ERROR); @@ -1276,20 +1271,11 @@ Interpret (int pop_return_p) stack_pointer = (STACK_LOCATIVE_OFFSET (stack_pointer, 1)); break; - case RC_SEQ_2_DO_2: + case RC_EXECUTE_SEQUENCE_FINISH: END_SUBPROBLEM (); POP_ENV (); REDUCES_TO_NTH (SEQUENCE_2); - case RC_SEQ_3_DO_2: - SET_ENV (STACK_REF (0)); - DO_ANOTHER_THEN (RC_SEQ_3_DO_3, SEQUENCE_2); - - case RC_SEQ_3_DO_3: - END_SUBPROBLEM (); - POP_ENV (); - REDUCES_TO_NTH (SEQUENCE_3); - case RC_SNAP_NEED_THUNK: /* Don't snap thunk twice; evaluation of the thunk's body might have snapped it already. */ diff --git a/src/microcode/returns.h b/src/microcode/returns.h index 0f9375d23..9f3a559df 100644 --- a/src/microcode/returns.h +++ b/src/microcode/returns.h @@ -39,9 +39,9 @@ USA. #define RC_EXECUTE_DEFINITION_FINISH 0x09 #define RC_EXECUTE_ACCESS_FINISH 0x0A /* unused 0x0B */ -#define RC_SEQ_2_DO_2 0x0C -#define RC_SEQ_3_DO_2 0x0D -#define RC_SEQ_3_DO_3 0x0E +#define RC_EXECUTE_SEQUENCE_FINISH 0x0C +/* unused 0x0D */ +/* unused 0x0E */ #define RC_CONDITIONAL_DECIDE 0x0F #define RC_DISJUNCTION_DECIDE 0x10 #define RC_COMB_1_PROCEDURE 0x11 @@ -108,9 +108,9 @@ USA. /* 0x09 */ "definition-continue", \ /* 0x0a */ "access-continue", \ /* 0x0b */ 0, \ -/* 0x0c */ "sequence-2-second", \ -/* 0x0d */ "sequence-3-second", \ -/* 0x0e */ "sequence-3-third", \ +/* 0x0c */ "sequence-continue", \ +/* 0x0d */ 0, \ +/* 0x0e */ 0, \ /* 0x0f */ "conditional-decide", \ /* 0x10 */ "disjunction-decide", \ /* 0x11 */ "combination-1-procedure", \ diff --git a/src/microcode/scode.h b/src/microcode/scode.h index a04ea13c2..13e77c1d1 100644 --- a/src/microcode/scode.h +++ b/src/microcode/scode.h @@ -167,10 +167,9 @@ USA. #define SCODE_QUOTE_OBJECT 0 #define SCODE_QUOTE_IGNORED 1 -/* SEQUENCE operations (two forms: SEQUENCE_2 and SEQUENCE_3) */ +/* SEQUENCE operations */ #define SEQUENCE_1 0 #define SEQUENCE_2 1 -#define SEQUENCE_3 2 /* VARIABLE operation. * Corresponds to a variable lookup or variable reference. Contains the diff --git a/src/microcode/typename.txt b/src/microcode/typename.txt index a34e72b2b..4d10ae8fa 100644 --- a/src/microcode/typename.txt +++ b/src/microcode/typename.txt @@ -27,7 +27,7 @@ 16 58 NON-MARKED-VECTOR 12 48 ENVIRONMENT 17 5C LAMBDA 14 50 EXTENDED-LAMBDA 18 60 PRIMITIVE 09 24 EXTENDED-PROCEDURE -19 64 SEQUENCE-2 1A 68 FIXNUM +19 64 SEQUENCE 1A 68 FIXNUM 1A 68 FIXNUM 2E B8 FUTURE 1B 6C PCOMB1 20 80 HUNK3-A 1C 70 CONTROL-POINT 24 90 HUNK3-B @@ -53,13 +53,13 @@ 30 C0 PCOMB0 32 C8 REFERENCE-TRAP 31 C4 VECTOR-16B 0B 2C RETURN-CODE 32 C8 REFERENCE-TRAP 03 0C SCODE-QUOTE -33 CC SEQUENCE-3 19 64 SEQUENCE-2 -34 D0 CONDITIONAL 33 CC SEQUENCE-3 -35 D4 DISJUNCTION 3B EC STACK-ENVIRONMENT -36 D8 CELL 2D B4 THE-ENVIRONMENT -37 DC WEAK-CONS 08 20 TRUE -38 E0 QUAD 05 14 UNINTERNED-SYMBOL -39 E4 LINKAGE-SECTION 25 94 UNUSED-25 +33 CC UNUSED-33 19 64 SEQUENCE +34 D0 CONDITIONAL 3B EC STACK-ENVIRONMENT +35 D4 DISJUNCTION 2D B4 THE-ENVIRONMENT +36 D8 CELL 08 20 TRUE +37 DC WEAK-CONS 05 14 UNINTERNED-SYMBOL +38 E0 QUAD 25 94 UNUSED-25 +39 E4 LINKAGE-SECTION 33 CC UNUSED-33 3A E8 RATNUM 2C B0 VARIABLE 3B EC STACK-ENVIRONMENT 0A 28 VECTOR 3C F0 COMPLEX 31 C4 VECTOR-16B diff --git a/src/microcode/types.h b/src/microcode/types.h index df4dc18fe..b909ea493 100644 --- a/src/microcode/types.h +++ b/src/microcode/types.h @@ -51,7 +51,7 @@ USA. #define TC_NON_MARKED_VECTOR 0x16 #define TC_LAMBDA 0x17 #define TC_PRIMITIVE 0x18 -#define TC_SEQUENCE_2 0x19 +#define TC_SEQUENCE 0x19 #define TC_FIXNUM 0x1A #define TC_PCOMB1 0x1B #define TC_CONTROL_POINT 0x1C @@ -77,7 +77,7 @@ USA. #define TC_PCOMB0 0x30 #define TC_VECTOR_16B 0x31 #define TC_REFERENCE_TRAP 0x32 -#define TC_SEQUENCE_3 0x33 +/* #define TC_UNUSED_33 0x33 */ #define TC_CONDITIONAL 0x34 #define TC_DISJUNCTION 0x35 #define TC_CELL 0x36 @@ -129,7 +129,7 @@ USA. /* 0x16 */ "non-marked-vector", \ /* 0x17 */ "lambda", \ /* 0x18 */ "primitive", \ - /* 0x19 */ "sequence-2", \ + /* 0x19 */ "sequence", \ /* 0x1A */ "fixnum", \ /* 0x1B */ "primitive-combination-1", \ /* 0x1C */ "control-point", \ @@ -155,7 +155,7 @@ USA. /* 0x30 */ "primitive-combination-0", \ /* 0x31 */ "vector-16b", \ /* 0x32 */ "reference-trap", \ - /* 0x33 */ "sequence-3", \ + /* 0x33 */ 0, \ /* 0x34 */ "conditional", \ /* 0x35 */ "disjunction", \ /* 0x36 */ "cell", \ diff --git a/src/runtime/conpar.scm b/src/runtime/conpar.scm index 02f233bbc..0d8855c93 100644 --- a/src/runtime/conpar.scm +++ b/src/runtime/conpar.scm @@ -811,7 +811,7 @@ USA. (standard-subproblem 'DISJUNCTION-DECIDE 3) (standard-subproblem 'EVAL-ERROR 3) (standard-subproblem 'FORCE-SNAP-THUNK 2) - (standard-subproblem 'SEQUENCE-2-SECOND 3) + (standard-subproblem 'SEQUENCE-CONTINUE 3) (standard-subproblem 'COMBINATION-SAVE-VALUE length/combination-save-value) diff --git a/src/runtime/framex.scm b/src/runtime/framex.scm index 9f17a15bc..4ca605f2d 100644 --- a/src/runtime/framex.scm +++ b/src/runtime/framex.scm @@ -218,7 +218,7 @@ USA. frame (select-subexp expression)))))) (case (vector-ref source-code 0) - ((SEQUENCE-2-SECOND) + ((SEQUENCE-CONTINUE) (win &pair-car)) ((ASSIGNMENT-CONTINUE DEFINITION-CONTINUE) @@ -267,7 +267,7 @@ USA. (record-method 'REENTER-COMPILED-CODE method/null) (let ((method (method/standard &pair-car))) (record-method 'DISJUNCTION-DECIDE method) - (record-method 'SEQUENCE-2-SECOND method)) + (record-method 'SEQUENCE-CONTINUE method)) (let ((method (method/standard &pair-cdr))) (record-method 'ASSIGNMENT-CONTINUE method) (record-method 'DEFINITION-CONTINUE method)) diff --git a/src/runtime/utabs.scm b/src/runtime/utabs.scm index 9f74669bb..a49e34977 100644 --- a/src/runtime/utabs.scm +++ b/src/runtime/utabs.scm @@ -146,14 +146,31 @@ USA. (define returns-slot) (define (microcode-return/name->code name) - (microcode-table-search returns-slot name)) + (microcode-table-search returns-slot + (let ((p + (find (lambda (p) + (memq name (cdr p))) + returns-aliases))) + (if p + (car p) + name)))) (define (microcode-return/code->name code) (microcode-table-ref returns-slot code)) +(define (microcode-return/code->names code) + (let ((name (microcode-table-entry types-slot code))) + (if name + (or (assq name returns-aliases) + (list name)) + '()))) + (define (microcode-return/code-limit) (vector-length (vector-ref (get-fixed-objects-vector) returns-slot))) +(define returns-aliases + '((sequence-continue sequence-2-second))) + (define errors-slot) (define (microcode-error/name->code name) @@ -240,6 +257,7 @@ USA. (BIGNUM BIG-FIXNUM) (PROMISE DELAYED) (FIXNUM ADDRESS POSITIVE-FIXNUM NEGATIVE-FIXNUM) + (SEQUENCE SEQUENCE-2) (STRING CHARACTER-STRING VECTOR-8B) (HUNK3-A UNMARKED-HISTORY) (TRIPLE HUNK3 HUNK3-B MARKED-HISTORY)