Remove last remnants of SEQUENCE-3. Rename return code for sequence-2 to sequence...

diff --git a/src/compiler/fggen/fggen.scm b/src/compiler/fggen/fggen.scm
index 9ce8396e719ecafdc2f917948b889bc5c2edbb96..5b0393a6df57f7241d87ab03c7a4892b7e44af5e 100644 (file)
--- 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 96768474c1bceb55d3a6d968a9029564e364036b..518e32508a882a7507854796d8739c7b1b838fbd 100644 (file)
--- 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 b0591a28cddf6c17bf2c2a75b6d5d556b3086211..a8e5ddb605990196f31b6585ee8e8534868c1955 100644 (file)
--- 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 0f9375d236f1662164fbaf67639617b8e541578a..9f3a559df6e161df08aea0a19b09fde33d99bfe3 100644 (file)
--- 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 a04ea13c28ee147cefefa068f8c496ef33773f37..13e77c1d1c538db3b26507e10c20f1067031d3b6 100644 (file)
--- 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
 \f
 /* 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 a34e72b2b791b0e380dd24f180feb778f4c0a904..4d10ae8fa785e158e183c4f04fbc9a8db7e16689 100644 (file)
--- 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 df4dc18fe534816e56b5aa17129a7b8fddfcef67..b909ea4936c8f40b783061c0a1c71ea7809e4047 100644 (file)
--- 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 02f233bbc18451aaa744e8e31f45156838acd43d..0d8855c935c6ac0f80582a5f438f162e6610374e 100644 (file)
--- 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 9f17a15bce55d334a9366b1f5e081e41969a1e59..4ca605f2dbdb8e2f7d9c5293d95c2f7b5105adea 100644 (file)
--- 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 9f74669bb6e59efe957c62862c94c969c05d59cf..a49e349776be18b32afbd8e4282d5bb9e9be44cd 100644 (file)
--- 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)