(FILECREATED "20-SEP-83 12:07:25" ("compiled on " {INDIGO}SOURCES>LOOPSMETHODS.;8) "14-SEP-83 19:33:36" recompiled exprs: ApplyMethod ApplyMethodInTtyProcess DoFringeMethods DoMethod _SuperFringe FindLocalMethod FindSelectorIndex Fix@$ FetchMethod FetchMethodOrHelp GetCallerClass GetNthMethod GetSuperMethod PutMethodNth _ _! _Super __ DCM in WORK dated "14-SEP-83 19:46:38") (FILECREATED "20-SEP-83 12:07:02" {INDIGO}SOURCES>LOOPSMETHODS.;8 22377 changes to: (MACROS MenuGetOrCreate) previous date: "10-JUN-83 14:44:15" {INDIGO}SOURCES>LOOPSMETHODS.;7) ApplyMethod D1 (P 0 classForMethod I 3 class I 2 argList I 1 selector I 0 object) \ C@Y!Id`hAJh ["JK AoC@ @B LLZ߰(117Q APPLY 111Q ERROR 106Q CONCAT 65Q GetNthMethod 55Q \FindEntryIndex) (43Q class 33Q class 22Q classTYPE#) (75Q "not a selector in ") ApplyMethodInTtyProcess D1 (I 4 waitFlg I 3 class I 2 argList I 1 selector I 0 object) g@gAhgBhChD (34Q EVAL.IN.TTY.PROCESS) (15Q QUOTE 6 QUOTE 2 ApplyMethod) NIL DoFringeMethods D1 (I 0 obj% selector% ..args) 0@d IHhZH&JAHZHYJHXJd`d` [d!Kd`h!_IMh ^MN  KPH LOO_]d\! Ld`h%_IOh _OO hH OO__(323Q APPLY 306Q GetNthMethod 273Q \FindEntryIndex 200Q APPLY 161Q GetNthMethod 151Q \FindEntryIndex 101Q GetLispClass 12Q EVAL) (261Q class 246Q class 235Q classTYPE# 170Q class 137Q class 125Q class 114Q classTYPE# 71Q classTYPE# 62Q instanceTYPE#) NIL DoMethod D1 (L (0 obj% selector% class% ..args) P 0 classForMethod) P0@d NMh_M&OYdIZIdd`d`JJ I[!Kd`h!_LMh ^)MN 8IoI'Jd`d`OO_]԰ JI (270Q APPLY 260Q ERROR 255Q CONCAT 252Q GetLispClass 167Q GetNthMethod 157Q \FindEntryIndex 105Q GetLispClass 15Q EVAL) (222Q classTYPE# 213Q instanceTYPE# 145Q class 133Q class 122Q classTYPE# 73Q classTYPE# 63Q instanceTYPE#) (200Q "not a selector for ") _SuperFringe D1 (I 0 obj% selector% ..args) @@ X@Y0@d MLh^L&NZHJZHIg d5d[!Kd`hILh ]LM hJ NN\(173Q APPLY 156Q GetNthMethod 146Q \FindEntryIndex 67Q GetCallerClass 30Q EVAL 7 EVAL) (134Q class 124Q class 113Q classTYPE# 73Q class 64Q _SuperFringe) NIL FindLocalMethod D1 (P 0 index I 1 selector I 0 class) A@h H@H (31Q GetNthMethod 16Q \FindEntryIndex) (4 class) NIL FindSelectorIndex D1 (I 1 selector I 0 class) A@d (14Q \FindEntryIndex) (4 class) NIL Fix@$ D1 (P 2 ATOM P 1 FORM P 0 FIRSTCHAR I 1 tail I 0 atom) M@k !HgHg"@l ZHJhAAIHgAIHAAIAd(32Q SUBATOM 4 NTHCHAR) (56Q @ 21Q @ 13Q $) NIL FetchMethod D1 (P 2 supers P 1 index P 0 class I 1 selector I 0 classRec) 6@!@d`hAHh YHI JJX(51Q GetNthMethod 42Q \FindEntryIndex) (30Q class 20Q class 11Q classTYPE#) NIL FetchMethodOrHelp D1 (P 10Q obj% P 7 supers P 6 index P 5 class P 0 class I 1 selector I 0 self) L P@d`d` HH!Md`h!_AMh ^MN H!Md`h1OO_]ް_gMh ^!MN '@Zg JAlIbnOO_]ܰgAgg@Agho a@`O[! Kd`h'_gOh _'OO  go OAlLgOO__װ(452Q ERROR 435Q GetNthMethod 422Q \FindEntryIndex 331Q HELP 236Q FetchMethodOrHelp 223Q GetNthMethod 213Q \FindEntryIndex 114Q GetNthMethod 104Q \FindEntryIndex 27Q GetLispClass) (472Q GetLastDefaultValue 467Q LastDefaultValue 443Q NoObjectForMsg 410Q class 403Q NoObjectForMsg 373Q class 362Q classTYPE# 342Q DefaultObject 315Q -- 307Q *** 302Q PrintOn 276Q _ 233Q MessageNotUnderstood 201Q class 175Q MessageNotUnderstood 165Q class 135Q classTYPE# 72Q class 60Q class 47Q classTYPE# 17Q classTYPE# 10Q instanceTYPE#) (447Q "not found for DoMethod" 326Q "not understood") GetCallerClass D1 (P 5 stkPos P 4 supersList P 3 index P 2 fn P 1 class P 0 callerName I 2 fromCaller I 1 selector I 0 object) qBQmMHhM ]AoBo M @d`d` YAIh [HIK ZM ILLY(143Q RELSTK 134Q GetNthMethod 124Q \FindEntryIndex 76Q GetLispClass 50Q STKNAME 43Q HELP 40Q CONCAT 16Q REALSTKNTH) (112Q class 102Q class 66Q classTYPE# 57Q instanceTYPE#) (35Q "_Super" 26Q "No caller found in ") GetNthMethod D1 (P 0 meths I 1 n I 0 class) @HdAk A(22Q FNTH) (3 class) NIL GetSuperMethod D1 (P 5 stkPos P 4 class P 3 supersList P 2 flg P 1 fn P 0 index I 2 callerName I 1 selector I 0 object) `B*gbmMBhM ]d oA M b@d`d` \ALh XBLH YiKK\JM IJAo h(202Q HELP 165Q RELSTK 140Q GetNthMethod 130Q \FindEntryIndex 102Q GetLispClass 52Q STKNAME 45Q HELP 34Q RELSTK 26Q REALSTKNTH) (116Q class 106Q class 72Q classTYPE# 63Q instanceTYPE# 10Q GetSuperMethod) (177Q "not understood in _Super" 41Q "No caller found in _Super for: ") PutMethodNth D1 (P 0 meths I 2 fn I 1 n I 0 class) *@H @o HAk BHABB(35Q FNTH 23Q ERROR) (3 class) (20Q "no methods in class") _ D1 (I 0 object% selector% ..args) i@Hdl#d-gH@ oH H Y Ho I@ I0@d KJh\J&L (146Q APPLY 120Q EVAL 103Q FetchMethodOrHelp 73Q ERROR 60Q EVAL 54Q GetObjectRec 47Q WRITE 35Q EVAL 32Q Fix@$) (21Q NOBIND) (70Q "is NIL." 43Q "Using $") _! D1 (P 2 classForMethod P 1 object^ P 0 objForm I 0 object% selector% ..args) e@Hdl-YdgoH H YHo I@ I0@d LKh]K&M (142Q APPLY 114Q EVAL 77Q FetchMethodOrHelp 74Q EVAL 61Q ERROR 47Q EVAL 43Q GetObjectRec 36Q WRITE) (22Q NOBIND) (56Q "is NIL." 32Q "Using $") _Super D1 (I 0 FORM@) Gmg @ @0@d IHhZH&JIJH H IK (104Q APPLY 76Q GetSuperMethod 72Q RELSTK 66Q STKNAME 33Q EVAL 14Q EVAL 7 REALSTKNTH) (4 _Super) NIL __ D1 (P 2 obj P 1 classForMethod P 0 objForm I 0 SEND% FORM) E@!Hdl-ZdgH Z@ J0@dLKh]K&M (102Q APPLY 43Q FetchMethodOrHelp 34Q EVAL 30Q GetObjectRec) (21Q NOBIND) NIL DCM D1 (P 0 argList I 1 selector I 0 className) K@ @o A @AHdgggggAhggAgh (110Q DM 105Q SUBST 24Q ARGLIST 21Q GetMethod 15Q ERROR 3 GetClassRec) (74Q argL 70Q self 65Q _SuperFringe 53Q for 50Q method 45Q Combined 42Q * 37Q argL) (12Q "not a defined class") (PRETTYCOMPRINT LOOPSMETHODSCOMS) (RPAQQ LOOPSMETHODSCOMS ((* Copyright (c) 1983 by Xerox Corporation) (MACROS * METHODMACROS) (MACROS * OTHERLOOPSMACROS) (FNS * METHODSFNS) (P (MOVD (QUOTE _) (QUOTE SEND))) (P (ADDTOVAR NLAMA __ _Super _! _ _SuperFringe DoMethod DoFringeMethods)) (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA __ _Super _! _ _SuperFringe DoMethod DoFringeMethods) (NLAML) (LAMA))))) (RPAQQ METHODMACROS (AVApply* DOAPPLY* DoMethod FetchMethod FindSelectorIndex MapSupersForm? SEND SENDSUPER _ _! _New _Super _Try)) (PUTPROPS AVApply* MACRO ((FRST . REST) (COND ((LISTP FRST) (EVAL FRST)) (T (DOAPPLY* FRST . REST))))) (PUTPROPS DOAPPLY* MACRO (arg (CONS (QUOTE APPLY*) arg))) (PUTPROPS DoMethod MACRO ((obj action class . args) (PROG ((obj% obj)) (RETURN (DOAPPLY* (OR ( FetchMethod (OR class (fetch CLASS of obj% )) action) (ERROR action "not found for DoMethod")) obj% . args))))) (PUTPROPS FetchMethod MACRO (OPENLAMBDA (classRec selector) (* dgb: " 9-JUN-83 22:27") (* Returns the function for selector or NIL) (PROG (index supers (class classRec)) (OR (type? class classRec) (RETURN )) (SETQ supers (fetch supers of classRec)) LP (COND ((SETQ index (FindSelectorIndex class selector)) (RETURN (GetNthMethod class index))) ((SETQ class (pop supers)) (GO LP)) (T (RETURN NIL)))))) (PUTPROPS FindSelectorIndex MACRO (OPENLAMBDA (class selector) (PROG NIL (* Prog is only so one can bomb out in case of NIL selectors of class) (RETURN (\FindEntryIndex selector (OR (fetch selectors of class) (RETURN))))))) (PUTPROPS MapSupersForm? MACRO ((mappingForm classRec . progArgs) (* dgb: "12-JAN-82 14:55") (* Maps through a class and its supers in order. Returns if form has return statement, or NIL when finished %. form can use class as free variable) (PROG (supers (class classRec) . progArgs) (COND ((NULL class) ( RETURN NIL))) (SETQ supers (Supers class)) LP mappingForm (* this is where the substitution goes) ON ( COND ((SETQ class (pop supers)) (* If there is a Super, iterate around the Loop) (GO LP))) (* Returns NotSetValue if not found) (RETURN NotSetValue)))) (PUTPROPS SEND MACRO ((obj action . args) (_ obj action . args))) (PUTPROPS SENDSUPER MACRO ((obj action . args) (_Super obj action . args))) (PUTPROPS _ MACRO ((obj action . args) (PROG ((oBj obj)) (DECLARE (LOCALVARS oBj)) (RETURN (DOAPPLY* ( FetchMethodOrHelp oBj (QUOTE action)) oBj . args))))) (PUTPROPS _! MACRO ((obj action . args) (PROG ((oBj obj)) (RETURN (PROG (classForMethod) (RETURN ( DOAPPLY* (FetchMethodOrHelp oBj action) oBj . args))))))) (PUTPROPS _New MACRO (form (COND ((NULL (CDR form)) (LIST (QUOTE _) (CAR form) (QUOTE New))) (T ( SUBPAIR (QUOTE (obj action . args)) form (QUOTE (PROG (classForMethod (obj% (_ obj New))) (DOAPPLY* ( FetchMethodOrHelp obj% (QUOTE action)) obj% . args) (RETURN obj% )))))))) (PUTPROPS _Super MACRO ((obj action . args) (PROG ((obj% obj)) (DECLARE (LOCALVARS . T)) (RETURN ( DOAPPLY* (GetSuperMethod obj% (QUOTE action)) obj% . args))))) (PUTPROPS _Try MACRO ((obj action . args) (PROG ((obj% obj)) (RETURN (DOAPPLY* (OR (FetchMethod obj% (QUOTE action)) (RETURN (QUOTE NotSent))) obj% . args))))) (RPAQQ OTHERLOOPSMACROS (ExtractObj MapSupersForm MapSupersUnlessBadList MenuGetOrCreate NextSuperClass)) (PUTPROPS ExtractObj MACRO ((datum) (OR (CAR (LISTP datum)) datum))) (PUTPROPS MapSupersForm MACRO ((mappingForm classRec . progArgs) (* dgb: "12-JAN-82 14:55") (* Maps through a class and its supers in order. Returns if form has return statement, or NIL when finished %. form can use class as free variable) (PROG (supers (class classRec) . progArgs) (COND ((NULL class) ( RETURN NIL))) (SETQ supers (Supers class)) LP mappingForm (* this is where the substitution goes) ON ( COND ((SETQ class (pop supers)) (* If there is a Super, iterate around the Loop) (GO LP))) (* Returns NIL if not found) (RETURN NIL)))) (PUTPROPS MapSupersUnlessBadList MACRO ((badList mappingForm classRec . progArgs) (* dgb: "12-JAN-82 14:55") (* Maps through a class and its supers in order. Returns if form has return statement, or NIL when finished %. form can use class as free variable) (PROG (supers (class classRec) . progArgs) (COND ((NULL class) (RETURN NIL))) (SETQ supers (Supers class)) LP (* Skip if super is on badList.) (OR (FMEMB (ClassName class) badList) mappingForm) (* this is where the substitution goes) ON (COND ((SETQ class (pop supers)) (GO LP))) (* Returns NIL if not found) (RETURN NIL)))) (PUTPROPS MenuGetOrCreate MACRO ((name items) (COND ((type? MENU (GETTOPVAL (QUOTE name))) name) (T ( SETTOPVAL (QUOTE name) (create MENU CHANGEOFFSETFLG _ T ITEMS _ items)))))) (PUTPROPS NextSuperClass MACRO (NIL (COND ((SETQ class (pop supers)) (* * This code assumes that LP is a defined PROG label and supers and class are bound) (* If there is a Super, iterate around the Loop) (GO LP))))) (RPAQQ METHODSFNS (ApplyMethod ApplyMethodInTtyProcess DoFringeMethods DoMethod _SuperFringe FindLocalMethod FindSelectorIndex Fix@$ FetchMethod FetchMethodOrHelp GetCallerClass GetNthMethod GetSuperMethod PutMethodNth _ _! _Super __ DCM)) (MOVD (QUOTE _) (QUOTE SEND)) (ADDTOVAR NLAMA __ _Super _! _ _SuperFringe DoMethod DoFringeMethods) NIL