From 133f7b4969a2240b08913a0a1cdcd7ef83cabc80 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Fri, 8 May 2026 23:59:31 -0700 Subject: [PATCH] Make (ARGLIST fn T) and (SMARTARGLIST fn T) a bit "smarter" with the atomic name of the arg for a LAMBDA nospread with a CCODEP definition. E.g., before (ARGLIST 'FONTCOPY T) returned U; now it returns FONTSPECS as in the CCODEP. Likewise for SMARTARGLIST. --- sources/LLINTERP | 121 ++++++++++++++++++++---------------------- sources/LLINTERP.LCOM | Bin 28090 -> 27980 bytes 2 files changed, 58 insertions(+), 63 deletions(-) diff --git a/sources/LLINTERP b/sources/LLINTERP index 079e91de..406fdc09 100644 --- a/sources/LLINTERP +++ b/sources/LLINTERP @@ -1,19 +1,13 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED "30-Jun-2022 22:42:02"  -{DSK}kaplan>local>medley3.5>working-medley>sources>LLINTERP.;4 120990 +(FILECREATED " 8-May-2026 23:51:41" {DSK}matt>Interlisp>medley>sources>LLINTERP.;2 120946 - :PREVIOUS-DATE "30-Jun-2022 18:04:04" -{DSK}kaplan>local>medley3.5>working-medley>sources>LLINTERP.;3) + :EDIT-BY "mth" + :CHANGES-TO (FNS \CCODEARGLIST) + + :PREVIOUS-DATE "30-Jun-2022 22:42:02" {DSK}matt>Interlisp>medley>sources>LLINTERP.;1) -(* ; " -Copyright (c) 1981-1988, 1990-1992, 1994-1995 by Venue & Xerox Corporation. -The following program was created in 1981 but has not been published -within the meaning of the copyright law, is furnished under license, -and may not be used, copied and/or disclosed except in accordance -with the terms of said license. -") (PRETTYCOMPRINT LLINTERPCOMS) @@ -1541,7 +1535,8 @@ with the terms of said license. (T (ERROR '"Args not available:" FN]) (\CCODEARGLIST - [LAMBDA (FNHD SMARTP) (* ; "Edited 10-May-88 12:18 by MASINTER") + [LAMBDA (FNHD SMARTP) (* ; "Edited 8-May-2026 23:44 by mth") + (* ; "Edited 10-May-88 12:18 by MASINTER") (* ;; "Computes the arglist for raw code object FNHD. If SMARTP is true, we're allowed to return a Common Lisp arg list if we find one; otherwise, we have to comply with Interlisp arglist semantics.") @@ -1556,53 +1551,55 @@ with the terms of said license. (SETQ SIZE (fetch (FNHEADER NTSIZE) of FNHD)) [COND ((EQ [SETQ LOCALSIZE (- (FOLDLO (if (fetch (FNHEADER NATIVE) of FNHD) - then (- (fetch (FNHEADER STARTPC) - of FNHD) - 4) + then (- (fetch (FNHEADER STARTPC) of FNHD) + 4) else (fetch (FNHEADER STARTPC) of FNHD)) BYTESPERWORD) (SETQ ENDT (+ (fetch (FNHEADER OVERHEADWORDS) of T) (COND ((EQ SIZE 0) (* ; - "No nametable, but there's a quad of zeros there anyway") + "No nametable, but there's a quad of zeros there anyway") WORDSPERQUAD) (T (UNFOLD SIZE 2] 0) (* ; "Nothing extra here") ) [(> LOCALSIZE WORDSPERCELL) (* ; - "There is a second nametable between the first and the code.") + "There is a second nametable between the first and the code.") (SETQ IVARS (\CCODEIVARSCAN FNHD ENDT (FOLDLO LOCALSIZE 2] ((AND (LISTP (SETQ ENDT (\GETBASEPTR FNHD ENDT))) (LISTP (CAR ENDT))) (* ; - "It's exactly a pointer to debugging info, car of which is a stylized arglist") + "It's exactly a pointer to debugging info, car of which is a stylized arglist") (SETQ ENDT (if (AND (EQ (CAAR ENDT) - '&OPTIONAL) - (LISTGET (CDR ENDT) - :INTERLISP)) - then (* ; "The &OPTIONAL, while strictly correct, is misleading, since it's technically true for ALL Interlisp functions.") - (CDAR ENDT) + '&OPTIONAL) + (LISTGET (CDR ENDT) + :INTERLISP)) + then (* ; "The &OPTIONAL, while strictly correct, is misleading, since it's technically true for ALL Interlisp functions.") + (CDAR ENDT) else (CAR ENDT))) (RETURN (COND (SMARTP ENDT) (T (* ; "Note that if we got this far, function can't be a nospread (we caught this in the very first COND up above), which means there can't be any &key or &rest") - (for X in ENDT unless (EQ X '&OPTIONAL) - collect (COND - ((STRINGP X) (* ; - "Callers of ARGLIST are expecting to get something that would actually function as one") - (MKATOM X)) - (T X] + (for X in ENDT unless (EQ X '&OPTIONAL) collect (COND + ((STRINGP X) + (* ; + "Callers of ARGLIST are expecting to get something that would actually function as one") + (MKATOM X)) + (T X] [COND ((< N 0) (* ; - "Waited until now to see if there was a stored arglist, but we didn't find one--give up") - (RETURN 'U] + "Waited until now to see if there was a stored arglist, but we didn't find one--give up") + (RETURN (COND + ((AND (EQ 2 (fetch (FNHEADER ARGTYPE) of FNHD)) + (SETQ IVARS (ASSOC 0 IVARS))) + (CDR IVARS)) + (T 'U] [COND ((NEQ SIZE 0) (* ; "Scan specials name table") (SETQ IVARS (\CCODEIVARSCAN FNHD (fetch (FNHEADER OVERHEADWORDS) of T) SIZE IVARS] - [SETQ IVARS (for I from 0 to (SUB1 N) - collect (OR (CDR (ASSOC I IVARS)) - (PACK* '*ARG* I] + [SETQ IVARS (for I from 0 to (SUB1 N) collect (OR (CDR (ASSOC I IVARS)) + (PACK* '*ARG* I] (RETURN (SELECTQ (fetch (FNHEADER ARGTYPE) of FNHD) (3 (CAR IVARS)) IVARS]) @@ -1745,33 +1742,31 @@ with the terms of said license. (ADDTOVAR LAMA APPLY* \INTERPRETER) ) -(PUTPROPS LLINTERP COPYRIGHT ("Venue & Xerox Corporation" T 1981 1982 1983 1984 1985 1986 1987 1988 -1990 1991 1992 1994 1995)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6409 23670 (\INTERPRETER 6419 . 11015) (\INTERPRETER1 11017 . 17585) ( -\SETUP-COMPILED-CLOSURE-CALL 17587 . 22734) (\STKNAME 22736 . 23668)) (23699 29111 (\ENVCALL.UFN 23709 - . 23841) (\SETUP-ENVIRONMENT-CALL 23843 . 29109)) (29150 34027 (EVAL 29160 . 29260) (\EVAL 29262 . -29472) (\EVALFORM 29474 . 30705) (\EVALFORMASLAMBDA 30707 . 30897) (\EVALOTHER 30899 . 31106) (APPLY -31108 . 31215) (APPLY* 31217 . 32332) (\CHECKAPPLY* 32334 . 33439) (\CKAPPLYARGS 33441 . 33784) ( -DEFEVAL 33786 . 34025)) (35871 43460 (EVALV 35881 . 36090) (\EVALV1 36092 . 36247) (\EVALVAR 36249 . -36612) (BOUNDP 36614 . 36830) (SET 36832 . 37198) (\SETVAR 37200 . 37570) (SETQ 37572 . 38244) ( -\STKSCAN 38246 . 41910) (\SETFVARSLOT 41912 . 43458)) (43494 56501 (PROG 43504 . 46020) (\PROG0 46022 - . 49652) (\EVPROG1 49654 . 49857) (RETURN 49859 . 50400) (GO 50402 . 51217) (EVALA 51219 . 53148) ( -\EVALA 53150 . 55743) (ERRORSET 55745 . 56350) (SI::ERRORSET-PRINT-FUNCTION 56352 . 56499)) (56560 -69212 (LET 56570 . 58713) (LET* 58715 . 60863) (\LET0 60865 . 64525) (\LET* 64527 . 69210)) (69213 -70789 (QUOTE 69223 . 69254) (AND 69256 . 69464) (OR 69466 . 69714) (PROGN 69716 . 69995) (COND 69997 - . 70331) (\EVPROGN 70333 . 70546) (PROG1 70548 . 70787)) (71277 78168 (ENVEVAL 71287 . 71537) ( -ENVAPPLY 71539 . 71796) (FUNCTION 71798 . 72028) (\FUNCT1 72030 . 74479) (\MAKEFUNARGFRAME 74481 . -76678) (STKEVAL 76680 . 76828) (STKAPPLY 76830 . 76999) (RETEVAL 77001 . 77605) (RETAPPLY 77607 . -78166)) (78289 85797 (BLIPVAL 78299 . 82200) (SETBLIPVAL 82202 . 84944) (BLIPSCAN 84946 . 85795)) ( -85798 86493 (\REALFRAMEP 85808 . 86491)) (86869 96264 (RAIDCOMMAND 86879 . 90485) (RAIDSHOWFRAME 90487 - . 90870) (RAIDSTACKCMD 90872 . 92053) (RAIDROOTFRAME 92055 . 92317) (PRINTADDRS 92319 . 92845) ( -PRINTVA 92847 . 92992) (READVA 92994 . 93072) (READATOM 93074 . 93656) (READOCT 93658 . 94289) ( -SHOWSTACKBLOCKS 94291 . 95537) (SHOWSTACKBLOCK1 95539 . 95690) (PRINCOPY 95692 . 95824) (NOSUCHATOM -95826 . 96262)) (96265 104893 (BACKTRACE 96275 . 96632) (\BACKTRACE 96634 . 97740) (\SCANFORNTENTRY -97742 . 99372) (\PRINTSTK 99374 . 99561) (\PRINTFRAME 99563 . 103546) (\PRINTBF 103548 . 104891)) ( -107393 116737 (CCODEP 107403 . 107678) (EXPRP 107680 . 107939) (SUBRP 107941 . 107996) (FNTYP 107998 - . 108758) (ARGTYPE 108760 . 109374) (NARGS 109376 . 109863) (ARGLIST 109865 . 111114) (\CCODEARGLIST -111116 . 115512) (\CCODEIVARSCAN 115514 . 116735)) (117687 119918 (CONSTANTS 117697 . 117988) ( -CONSTANTEXPRESSIONP 117990 . 119916))))) + (FILEMAP (NIL (6111 23372 (\INTERPRETER 6121 . 10717) (\INTERPRETER1 10719 . 17287) ( +\SETUP-COMPILED-CLOSURE-CALL 17289 . 22436) (\STKNAME 22438 . 23370)) (23401 28813 (\ENVCALL.UFN 23411 + . 23543) (\SETUP-ENVIRONMENT-CALL 23545 . 28811)) (28852 33729 (EVAL 28862 . 28962) (\EVAL 28964 . +29174) (\EVALFORM 29176 . 30407) (\EVALFORMASLAMBDA 30409 . 30599) (\EVALOTHER 30601 . 30808) (APPLY +30810 . 30917) (APPLY* 30919 . 32034) (\CHECKAPPLY* 32036 . 33141) (\CKAPPLYARGS 33143 . 33486) ( +DEFEVAL 33488 . 33727)) (35573 43162 (EVALV 35583 . 35792) (\EVALV1 35794 . 35949) (\EVALVAR 35951 . +36314) (BOUNDP 36316 . 36532) (SET 36534 . 36900) (\SETVAR 36902 . 37272) (SETQ 37274 . 37946) ( +\STKSCAN 37948 . 41612) (\SETFVARSLOT 41614 . 43160)) (43196 56203 (PROG 43206 . 45722) (\PROG0 45724 + . 49354) (\EVPROG1 49356 . 49559) (RETURN 49561 . 50102) (GO 50104 . 50919) (EVALA 50921 . 52850) ( +\EVALA 52852 . 55445) (ERRORSET 55447 . 56052) (SI::ERRORSET-PRINT-FUNCTION 56054 . 56201)) (56262 +68914 (LET 56272 . 58415) (LET* 58417 . 60565) (\LET0 60567 . 64227) (\LET* 64229 . 68912)) (68915 +70491 (QUOTE 68925 . 68956) (AND 68958 . 69166) (OR 69168 . 69416) (PROGN 69418 . 69697) (COND 69699 + . 70033) (\EVPROGN 70035 . 70248) (PROG1 70250 . 70489)) (70979 77870 (ENVEVAL 70989 . 71239) ( +ENVAPPLY 71241 . 71498) (FUNCTION 71500 . 71730) (\FUNCT1 71732 . 74181) (\MAKEFUNARGFRAME 74183 . +76380) (STKEVAL 76382 . 76530) (STKAPPLY 76532 . 76701) (RETEVAL 76703 . 77307) (RETAPPLY 77309 . +77868)) (77991 85499 (BLIPVAL 78001 . 81902) (SETBLIPVAL 81904 . 84646) (BLIPSCAN 84648 . 85497)) ( +85500 86195 (\REALFRAMEP 85510 . 86193)) (86571 95966 (RAIDCOMMAND 86581 . 90187) (RAIDSHOWFRAME 90189 + . 90572) (RAIDSTACKCMD 90574 . 91755) (RAIDROOTFRAME 91757 . 92019) (PRINTADDRS 92021 . 92547) ( +PRINTVA 92549 . 92694) (READVA 92696 . 92774) (READATOM 92776 . 93358) (READOCT 93360 . 93991) ( +SHOWSTACKBLOCKS 93993 . 95239) (SHOWSTACKBLOCK1 95241 . 95392) (PRINCOPY 95394 . 95526) (NOSUCHATOM +95528 . 95964)) (95967 104595 (BACKTRACE 95977 . 96334) (\BACKTRACE 96336 . 97442) (\SCANFORNTENTRY +97444 . 99074) (\PRINTSTK 99076 . 99263) (\PRINTFRAME 99265 . 103248) (\PRINTBF 103250 . 104593)) ( +107095 116821 (CCODEP 107105 . 107380) (EXPRP 107382 . 107641) (SUBRP 107643 . 107698) (FNTYP 107700 + . 108460) (ARGTYPE 108462 . 109076) (NARGS 109078 . 109565) (ARGLIST 109567 . 110816) (\CCODEARGLIST +110818 . 115596) (\CCODEIVARSCAN 115598 . 116819)) (117771 120002 (CONSTANTS 117781 . 118072) ( +CONSTANTEXPRESSIONP 118074 . 120000))))) STOP diff --git a/sources/LLINTERP.LCOM b/sources/LLINTERP.LCOM index 7abb7a4a03883bb9df4400881eac8a581787fe38..4a24ebca5af7cc84efe249e6a4cdd7e76bd50aca 100644 GIT binary patch delta 649 zcmb7?Pm9w)7{*QAgXFY=EdGOi9Z=drLMCa`?kK6V$)r0pO-eE?EO@DH*miB&(smE4 z$bN<;ev)1E;6=QN_zCpt&5Pg{a8||tmz~ovFY~<5?|I*sAC!0Rl}6EHJ`b7Z^MGkQ z^dlf0>b7W;0pg)xaln%f0unRo3A!Ep^?cm8dIjoQyML&ehG~Ookt!w?^Z3!VqtPr& zovgoFIefZG7nAXF?qun3k{&wC*}-CvE}bCw)}y1}HA{fZnnve~??TujMwJ*C!NWy5 zm}T?vBpt$F)SvF9%i9Fh2d*1=jK)oAP{4Q!$nORL{L(nGLDzKz!~RPC{72j-#uh56 z#WQeM(h24P`VWe9@We}6Pw$-%2e4-vTNN8r!aOdt?Oj0GY9y0%cWBsTi6$Z_`e6cp zfRtqXG3)WDn`oZ&lsA-3{al^#>E*(USi$)lfs|JMN!Xh=_jkUWJih;S?bf95`Pn|- zcz$W`f;{Vmb>-s8#~gQGm1`Kz=3WNVto*RVdo)g58Un6c&~8x?wE@>E`SsonsuoSV t3S}988L+(Fi8_KuAq@aq7LcEt16a!aRy69+m7$l^(}UjYjkS;m>Q|7IxQqY* delta 760 zcmbu7L2J}N6vvI?C9qIXL=oy^z>=(FnaOTql9tpo$!_DONysKa!Asl?+wG>wlHEl` zq({$Xzex)oyoeVM;wRA0;Hh80jH0&UNr&Ngc=P7}=KbG%`pmrj!fbPv-E}-$=sK<~ zI9}I>^}sOuM$ZQ1c#$2t&LBXr9@>T#89VMD;p6R_*V|ZlxGV$_iz0}k))6%wYg9v^G0DpbN@a z6S0OR1nko)8b}}7bs@EEG<>YL&6TfRpGSD$Mp?)GfF-_mHox}(S zrr`mR71-+=k-rB-Qdjqq+YcI?C}C(CVXs-oFl_iioCHKgSHFA3P47-fjdOO0r^^!3I3as`5FQWi>0SbTKIl1Q8Hb mArvA-o1#M@QOFecDHLD{wY&z+R%y0M6IF@lud<%wvflv67TCc6