Sketch of design for "cheap" multiple values [Masinter, 30 Jul 85] OK, here's a mimimal-microcode/compiler multiple-value-hack. New opcode: [rest-mv-list] Returns the "rest" of the multiple values from the previous expression, as . The microcode for [RestMVList] returns NIL, i.e., its equivalent to 'NIL. (You can make it 0-arg UFN that returns NIL). This still needs some debugging, but maybe you get the idea? (DEFUN \MV-LIST (VALUE) (LIST VALUE)) (DEFUN \REST-MV-LIST () NIL) (PUTPROPS MULTIPLE-VALUES-LIST DMACRO COMP.MV-LIST) (DEFUN COMP.MV-LIST (FORMS) (SELECTQ (COMP.EXPR (CAR FORMS) 'MV-LIST) (MV-LISTED) (COMP.STFN '\MV-LIST 1)) (DEFUN COMP.MV-SPREAD (FORM N) (* compiles form, spread N multiple values on stack) (LET((V (COMP.EXPR FORM (CONS MV-SPREAD 1)))) (if (NEQ V 'MV-SPREAD) then (* no local multiple values encountered) (if (EQ N 0) then (COMP.STPOP) elseif (EQ N 1) then (* want only one value) NIL else (COMP.STFN '\REST-MV-LIST 0) (while (GREATERP N 2) do (COMP.STFN '(OPCODES COPY CDR SWAP CAR) 0) (COMP.STFN 'CAR 1))))) (PUTPROPS VALUES DMACRO COMP.VALUES) (DEFUN COMP.VALUES (FORMS) (* compiles a VALUES expression) (SELECTQ COMPILE.CONTEXT (RETURN (* in return context turns into MV-RETURN) (COMP.EXPR `(\MV-RETURN ,@ FORMS))) (MV-SPREAD (MAPC FORMS (FUNCTION COMP.EXPR)) (SETQ AC T) (* tell compiler not to barf at extra stuff on stack) (RETFROM 'COMP.EXPR (CONS 'MV-SPREAD (LENGTH FORMS))) (MV-LIST (COMP.EXPR (CONS 'LIST FORMS)) (RETFROM 'COMP.EXPR 'MV-LISTED)) (PROGN (* in most other contexts, turns into a PROG1) (COMP.PROG1 FORMS)] (DEFMACRO \FRAMENEXTBYTE (FRAME) (\GETBASEBYTE (fetch (FX FNHEADER) of FRAME) (fetch (FX PC) of FRAME))) (DEFINEQ(\MV-RETURN N (* this is pure Interlisp-D) (UNINTERRUPTABLY (* because its modifying the stack) (PROG((FRAME (\MYALINK))) RETRY (SELECTC (\FRAMENEXTBYTE FRAME) ((OP# RETURN) (* tail recursive call - backup a frame and try again) (SETQ FRAME (FETCH (FX CLINK) OF FRAME)) (\SMASHLINK NIL FRAME FRAME) (GO RETRY)) (((OP# FN0) (OP# FN1)) (* FN0 for \REST-MV-LIST and FN1 for \MV-LIST) (SELECTQ (\FRAMENEXTFN FRAME) (\MV-LIST (ADD (FETCH (FX PC) of FRAME) 3) (* skip over call) (RETURN (for I from 1 to N collect (ARG N I)))) (\REST-MV-LIST (ADD (FETCH (FX PC) of FRAME) 3) (* skip over the call) (SELECTC (\FRAMENEXTBYTE FRAME) (CONS (add (fetch (FX PC) of FRAME) 1) (* skip over the CONS too) (RETURN (for I from 1 to N collect (ARG N I)))) (FN0 (if (EQ (\FRAMENEXTFN FRAME) (PROGN ...see below...)) NIL) NIL) RETNORMAL (RETURN (if (EQ N 0) then NIL else (ARG N 1] (DEFUN \FRAMENEXTFN (FRAME) (LET((BASE (FETCH (FX FNHEADER) OF FRAME)) (PC (FETCH (FX PC) OF FRAME))) (\VAG2 0 (LOGOR (LSH (\GETBASEBYTE BASE (+ PC 1)) 8) (\GETBASEBYTE BASE (+ PC 2)))))) (DEFMACRO MULTIPLE-VALUE-CALL (FUNCTION &REST FORMS) `(APPLY ,FUNCTION ,(MV-COLLECT FORMS))) (DEFMACRO MULTIPLE-VALUE-BIND (VARS VALUES-FORM &REST TAIL) (DESTRUCTURING-BIND (,VARS (MULTIPLE-VALUE-LIST ,@VALUES-FORM)) ,@TAIL) (* not very satisfactory, try:) `(LET ,(MVB VARS VALUES-FORM) ,@TAIL)) (DEFUN MVB (VARS VALUES) (CONS (LIST (OR (CAR VARS) 'DUMMY) VALUES) (MVB-1 (CDR VARS)))) (DEFUN MVB-1 (VARS) (AND VARS (IF (CDR VARS) THEN `((,(CAR VARS) (\SPREAD(\MV-REST-LIST))) ,@(MVB-2 (CDR VARS))) ELSE `((,(CAR VARS) (CAR (\MV-REST-LIST))))))) (DEFUN MVB-2 (VARS) (IF (CDR VARS) THEN `((,(CAR VARS) (\SPREAD ,DONOTHING)) ,@(MVB-2 (CDR VARS))) ELSE `((,(CAR VARS) (CAR ,DONOTHING)))))) (* this is an awful hack to get a simple destructuring bind) (DEFUN MV-COLLECT (FORMS) (AND FORMS `(CONS ,(CAR FORMS) (NCONC (REST-MV-LIST) ,(MV-COLLECT (CDR FORMS)))))) (DEFMACRO MULTIPLE-VALUE-PROG1 (FORM &REST FORMS) (* not worth tuning) `(VALUES-LIST (PROG1 (MULTIPLE-VALUES-LIST ,FORM) ,@FORMS)))) (DEFCONSTANT MULTIPLE-VALUES-LIMIT 1000) Hard cases: In COMP.VALUES when COMPILE.CONTEXT is MV-LIST, needs to compile code to list the values and return MV-LISTED; if the context is MV-SPREAD, need to return that too. TERMINAL TERMINAL  TIMESROMAN  TIMESROMAN Ÿf´¾zº