(FILECREATED "20-SEP-83 12:00:39" ("compiled on " {INDIGO}SOURCES>LOOPSSTRUC.;6) "14-SEP-83 19:33:36" recompiled exprs: ComputeGetValue ComputePutValue DumpClassFacts DumpInstanceFacts DumpPruneDescr DumpPruneDescr1 EntityModified FastClassInitialize FillIVs FillInClass FillInClass1 GetEntityRec GetIVDescr GetIVHere GetInitialValue GetObjFromUID GetObjectName1 GetValue GetValueOnly GetClassRec GetObjectName GetObjectRec NameEntity NewEntity PutValue PutValueOnly UnNameEntity BlankInstance DefineMethod FillInst FireInit IVSource ModifyInstance NameObject NewClass NewObject NewWithValues SubstInAV TemplateCopy UpdateClassIVs UpdateIVDescrs in WORK dated "14-SEP-83 19:46:38") (FILECREATED "20-SEP-83 11:59:33" {INDIGO}SOURCES>LOOPSSTRUC.;6 59279 changes to: (FNS PutValue GetValue) previous date: " 9-SEP-83 14:31:42" {INDIGO}SOURCES>LOOPSSTRUC.;5) ComputeGetValue D1 (P 2 index P 1 varName P 0 varExpr I 0 arg F 3 VarNameIndexes) 0@XgHS Zdd@gggg@hhgggoggggJhhooigg@@ohhhh(25Q FASSOC) (160Q self 155Q GetIt 124Q self 121Q GetVarNth 116Q descr 113Q SETQ 104Q AND 101Q COND 76Q RETURN 63Q self 60Q descr 55Q PROG 51Q IGNOREMACRO 13Q QUOTE) (173Q ((QUOTE IV)) 150Q (descr) 141Q ((NEQ (SETQ descr (CAR descr)) NotSetValue) (NOT (type? activeValue descr))) 110Q (type? instance self)) ComputePutValue D1 (P 2 index P 1 varName P 0 varExpr I 0 arg F 3 VarNameIndexes) 0@XgHS Zdd@ggggg@hhgggoggggJhhogg@hhigg@@@ohhhh(25Q FASSOC) (201Q self 176Q PutIt 157Q descr 154Q RPLACA 131Q self 126Q GetVarNth 123Q descr 120Q SETQ 111Q AND 106Q COND 103Q RETURN 67Q self 64Q descr 61Q oldV 56Q PROG 52Q IGNOREMACRO 13Q QUOTE) (221Q ((QUOTE IV)) 146Q ((NEQ (SETQ oldV (CAR descr)) NotSetValue) (NOT (type? activeValue oldV))) 115Q (type? instance self)) DumpClassFacts D1 (P 4 nm P 0 filePos I 1 fileHandle I 0 class) A 1gA @A @A @A @ A @ 4d@L@jJKIK[h hIkذk A @ A @ A @ A @ A @ A @ A H(300Q PRINT 274Q DumpPruneDescr1 271Q \ListFromBlock 260Q PRINT 254Q \ListFromBlock 243Q PRINT 237Q \ListFromBlock 226Q PRINT 222Q DumpPruneDescr1 211Q PRINT 205Q DumpPruneDescr 174Q PRINT 155Q PRINT 150Q FNTH 65Q PRINT 53Q PRINT 41Q PRINT 27Q PRINT 15Q PRINT 3 GETFILEPTR) (264Q class 247Q class 232Q class 215Q class 200Q class 166Q class 71Q class 57Q class 45Q class 33Q class 21Q class 11Q C) NIL DumpInstanceFacts D1 (P 11Q descr P 10Q exceptions P 7 name P 3 i P 0 filePos I 1 fileHandle I 0 instanceRec) A gA @@jb JL@ A H_@Og _g@ @ K_OOgOSOgOhEOAgOgO0 O$dYOh IIh_O+O__OMNh]JKkػNN& _O(332Q LAST 123Q ReadLeafObj 100Q GetValueOnly 61Q PRINT 54Q \NCONC2 15Q PRIN1 3 GETFILEPTR) (211Q ? 202Q Value 164Q Value 147Q ? 105Q Any 75Q DontSave 47Q instance 27Q instance 21Q instance 11Q i) NIL DumpPruneDescr D1 (P 5 dontSaveList P 4 descr I 0 descrList) @aHI@g g]dghTgLLLgMh@L=gMgL0 L#d^Mh NNh_O%O__OJ KhZHXK& _O(213Q LAST 23Q LISTGET) (103Q ? 75Q Value 61Q Value 46Q ? 35Q Any 30Q ? 20Q DontSave) NIL DumpPruneDescr1 D1 (P 5 dontSaveList P 4 descr I 0 descrList) @aHI@g g]dghGgL?LgMh3L00 L$d^Mh NNh_O$O__OJ KhZHXK& _O(175Q LAST 22Q LISTGET) (60Q Value 45Q ? 34Q Any 27Q ? 17Q DontSave) NIL EntityModified D1 (L (0 entity)) @HdddhHNIL (3 Entity) NIL FastClassInitialize D1 (P 7 propName P 6 propTail P 4 value P 3 descr P 2 varName I 1 self I 0 class) b@@2IHhAJK \gAJL K!M^AJK \gAJLK NIH(121Q PutValueOnly 103Q FireInit 60Q PutValueOnly 44Q FireInit) (107Q ? 50Q ? 11Q class 3 class) NIL FillIVs D1 (P 0 d I 3 unmodifiedFlg I 2 descrList I 1 class I 0 self) A@C bBtdQ@HHONjJKIK[h\N N LO*9IkذN ]ddN OM NMOOh  @O(167Q \NCONC2 146Q ASSOC 135Q ReadLeafObj 71Q ReadLeafObj 5 BlankInstance) (154Q instance 113Q instance) NIL FillInClass D1 (I 1 classFileForm I 0 class) @A@A @A@A@A@A @A @A @@AHI I@A@A (243Q InstallSupers 164Q \BlockFromList 137Q \BlockFromList 113Q \BlockFromList) (221Q class 176Q class 172Q class 145Q class 121Q class 76Q class 57Q class 42Q class 26Q class 13Q class 3 class) NIL FillInClass1 D1 (P 7 realDescr P 6 fakeDescr P 2 supers P 1 fakeDescrs P 0 localNames I 1 fileHandle I 0 classRec) 0@A @A A Z@A X @H@0HghLKh]K&MY@J I!MJ@A  @A @A @A @A @A h^A _NOM](254Q READ 242Q \BlockFromList 237Q READ 225Q \BlockFromList 222Q READ 210Q \BlockFromList 205Q READ 173Q READ 161Q READ 147Q READ 126Q InstallSupers 43Q READ 32Q READ 24Q READ 12Q READ) (233Q class 216Q class 201Q class 167Q class 155Q class 143Q class 72Q ? 61Q class 52Q class 37Q class 20Q class 6 class) NIL GetEntityRec D1 (I 0 uid) `@`@` @o (31Q ERROR) (16Q GlobalNameTable 7 CurrentNameTable 2 CurrentNameTable) (26Q "has no corresponding entity in CurrentNameTable") GetIVDescr D1 (I 2 createDescrFlg I 1 varName I 0 self) BA@jKLJL\8hXd8@ @ Hd@Hgh]MM NI*IJkذA@ Y@_g _OAilOdIg&I@`@o `A@jJKIK[hXd@ @ HIkذA@ @\g LAhlM(340Q FetchMethodOrHelp 326Q ASSOC 274Q ReadLeafObj 226Q ERROR 154Q FetchMethodOrHelp 140Q ASSOC 112Q ReadLeafObj 51Q ReadLeafObj) (335Q IVMissing 321Q instance 214Q instanceTYPE# 202Q ? 151Q IVMissing 133Q instance 73Q ?) (223Q "not instance for FetchIVDescr") GetIVHere D1 (I 2 propName I 1 varName I 0 self) @Hg HAlIo@`@o U`A@jJKIK[hX@ @ H$IkذA@ !@]g MAhlLHlgBHHYBIII(157Q FetchMethodOrHelp 145Q ASSOC 112Q ReadLeafObj 44Q ERROR 12Q FetchMethodOrHelp) (205Q ? 154Q IVMissing 140Q instance 32Q instanceTYPE# 7 HasIV) (41Q "not instance for FetchIVDescr") GetInitialValue D1 (P 1 ls P 0 fn I 2 prop I 1 varName I 0 self) V@AB `?@AB @AB @AB HI@AIB@AB hlH @AB (123Q FetchCIVValueOnly 112Q EVAL 100Q FetchCIVValueOnly 51Q GetLocalState 43Q FetchCIVValueOnly 26Q FetchCIVValueOnly 7 FetchCIVValueOnly) (31Q activeValue 13Q activeValueTYPE#) NIL GetObjFromUID D1 (I 0 uid) @ (6 GetObjectRec 3 MKATOM) NIL NIL GetObjectName1 D1 (I 1 key I 0 value F 0 object) @PA@gAi h(32Q RETFROM) (25Q GetObjectName 16Q Entity 3 Entity) NIL GetValue D1 (P 12Q ls P 11Q fn P 7 value P 6 descr I 2 prop I 1 varName I 0 self) @d``@o U`A@jJKIK[hX@ @ H$IkذA@ W@]g MAhlL!NNl;g_dg@AB _`ROO@AB  O&OBNN_BOOO@AOBOhlO OABg (362Q GetIt 346Q EVAL 246Q GetLocalState 216Q FetchCIVValueOnly 143Q FetchMethodOrHelp 131Q ASSOC 76Q ReadLeafObj 30Q ERROR) (357Q IV 234Q activeValue 224Q activeValueTYPE# 203Q ? 175Q ? 140Q IVMissing 124Q instance 16Q instanceTYPE# 5 instanceTYPE#) (25Q "not instance for FetchIVDescr") GetValueOnly D1 (P 0 value I 2 propName I 1 varName I 0 self) @d`AB `@ABg Add@AB @`@o QA@jJKIK[h^@ @ N$IkذA@ 0@]g MAhlL_lgXdg𲋿@AB BOO_BOOO(257Q FetchCIVValueOnly 212Q FetchMethodOrHelp 200Q ASSOC 145Q ReadLeafObj 102Q ERROR 57Q FetchNthValueOnly 34Q GetItOnly 14Q GetClassIV) (243Q ? 236Q ? 207Q IVMissing 173Q instance 70Q instanceTYPE# 31Q IV 21Q instanceTYPE# 5 classTYPE#) (77Q "not instance for FetchIVDescr") GetClassRec D1 (P 0 classRec I 1 environment I 0 className) '@d`A Hdd`@o H(43Q HELP 14Q GetObjectRec) (30Q classTYPE# 5 classTYPE#) (40Q " is a defined object, but is not a class.") GetObjectName D1 (I 1 env I 0 object) 6@`@ A`g `dg hg g (61Q MAPHASH 53Q GetValue 43Q MAPHASH 27Q MAPHASH 12Q ClassName) (56Q GetObjectName1 50Q nameTable 40Q GetObjectName1 33Q CurrentNameTable 24Q GetObjectName1 21Q GlobalNameTable 4 classTYPE#) NIL GetObjectRecA0083 D1 (NAME ERRORSET L (2 ERRORSET.W 1 ERRORSET.V 0 ERRORSET.U) F 0 objectRec F 1 environment F 2 entityRec) gQg RP ch(22Q ReadFacts 14Q SETTOPVAL 11Q GetValue) (6 nameTable 2 CurrentNameTable) NIL GetObjectRec D1 (P 4 MACROY P 3 MACROX P 2 nameTable P 1 objectRec P 0 entityRec I 1 environment I 0 name F 5 RESETVARSLST) 0@d``@Adi`b@Ag @` `@`XdUYdddBAHI ` gd Uc og gK Kc LI(216Q ERROR! 203Q SETTOPVAL 171Q GetObjectRecA0083 151Q GETTOPVAL 130Q ReadFacts 46Q GetValue) (175Q CurrentNameTable 166Q INTERNAL 145Q CurrentNameTable 134Q CurrentEnvironment 77Q Entity 67Q CurrentNameTable 61Q CurrentNameTable 53Q GlobalNameTable 43Q nameTable 33Q GlobalEnvironment 16Q classTYPE# 10Q instanceTYPE#) (163Q (DUMMY.FOR.ERRORSET)) NameEntity D1 (P 1 entity P 0 oldEntity I 2 globalNameFlg I 1 name I 0 self F 4 ErrorOnNameConflict) @AdlAo @d`d`o @i A X%@dH TAo H[g KAlJ@iB`)A@ dgggg@o i AI@B`` @(242Q PUTHASH 217Q MARKASCHANGED 213Q ERROR 156Q TYPENAME 124Q FetchMethodOrHelp 113Q HELPCHECK 67Q GetObjectRec 62Q GetEntityRec 57Q UID 51Q ERROR 22Q ERROR) (237Q GlobalNameTable 232Q CurrentNameTable 202Q classes 175Q class 170Q INSTANCES 162Q instance 147Q CurrentNameTable 121Q UnSetName 40Q classTYPE# 31Q instanceTYPE#) (210Q "not an object" 110Q "is already used as a name for an object in this environment. To continue type OK" 46Q "cannot be named as Entity." 17Q "Should be an atom to be a name") NewEntity D1 (P 1 newEntity P 0 UID I 3 nameTable I 2 kbName I 1 names I 0 facts F 3 DefaultKBName) cA!AHh  lAHhb`d@dHBSdJY@HC ``bAdIC @(132Q PUTHASH 30Q MKATOM 24Q LAST 6 DB-PackUI) (117Q GlobalNameTable 112Q CurrentNameTable 52Q EntityTYPE#) NIL PutValue D1 (P 21Q fn P 12Q value P 11Q descr I 3 propName I 2 newValue I 1 varName I 0 self) ~@d`jA@jKLJL\8hX9@ @ HG@Hgh]MM NI*I*JkذA@ YG@_g _OAilOqOl3g_dg=@d`d`43dIg&ICOO_COOO A@d`d` __j_OOOO_h hOkذk _ l CO O _COOOg_d`}`:OCBIHJJHIJK^hNLMhMLNNMMNOg+@iO _OCOIHJHIJK^&O`OOO",OB@AC NLMhLNNMN@ABCOhlO" @iC>OCBIHJHIJK^%NLMhLNNMNOBBABCg (1173Q PutIt 1047Q EVAL 763Q PutLocalState 663Q CopyAV 445Q FNTH 370Q GetLispClass 340Q GetLispClass 163Q FetchMethodOrHelp 147Q ASSOC 117Q ReadLeafObj 57Q ReadLeafObj) (1167Q IV 740Q activeValue 730Q activeValueTYPE# 646Q SHARED 641Q activeValue 541Q ImplicitReplaceFns 534Q activeValue 526Q activeValueTYPE# 517Q ? 360Q classTYPE# 351Q instanceTYPE# 267Q ? 250Q classTYPE# 241Q instanceTYPE# 225Q ? 217Q ? 160Q IVMissing 142Q instance 100Q ? 5 instanceTYPE#) NIL PutValueOnly D1 (I 3 propName I 2 newValue I 1 varName I 0 self)  @d`ABC `Add@ABC @iA@jKLJL\8hX9@ @ HG@Hgh]MM NI*I*JkذA@ Y&@_g _OAilOCBIHJJdIg&IHIJK^hNLMhMLNNMMN@ @o Hg H@ABClI(402Q FetchMethodOrHelp 370Q HELP 356Q GetLispClass 227Q FetchMethodOrHelp 213Q ASSOC 163Q ReadLeafObj 123Q ReadLeafObj 52Q StoreNthValueOnly 15Q PutClassIV) (377Q PutValueOnly 272Q ? 224Q IVMissing 206Q instance 144Q ? 22Q instanceTYPE# 5 classTYPE#) (365Q "has no instance variables.") UnNameEntity D1 (I 2 environment I 1 name I 0 self) XA @B bdB @DA` @iBAh` `&Ah` iAhBHg HkI (125Q PUTHASH 113Q FetchMethodOrHelp 71Q PUTHASH 54Q PUTHASH 32Q DREMOVE 17Q GetObjectRec 7 GetObjectName) (110Q NameTable 66Q CurrentNameTable 57Q CurrentNameTable 51Q GlobalNameTable 35Q AllObjectNames 27Q AllObjectNames) NIL BlankInstance D1 (P 0 ivnms I 2 unmodifiedFlg I 1 obj I 0 class) lA`b@@ A`bBAi@AHBdAB AhAh AH ghj A(146Q ARRAY 136Q FLENGTH 21Q GetClassRec) (141Q POINTER 132Q instance 122Q instance 113Q instance 103Q instance 63Q instance 52Q class 33Q OBJECT 13Q instance 5 instanceTYPE#) NIL DefineMethod D1 (P 3 editFlg P 2 file P 1 fnName P 0 className I 3 expr I 2 argsOrFn I 1 selector I 0 class F 10Q LASTWORD) AlAo @ qBCh[ghbo bBCBbghlBY4BggBbCigBC bHgA YChh Hg ZIgJ @AI K@]g MAlL@_g OAhilNIcChb(264Q FetchMethodOrHelp 242Q FetchMethodOrHelp 227Q AddMethod 220Q ADDTOFILE 205Q WHEREIS 175Q DEFINE 163Q PACK* 150Q FIXEDITDATE 55Q COPY 22Q ClassName 15Q ERROR) (261Q CommentMethods 237Q EditMethod 214Q FNS 202Q CLASSES 157Q %. 141Q LAMBDA 125Q self 120Q self 75Q self 41Q self) (52Q ((* New method template) self) 12Q "is not a LIATOM, so cannot be a selector") FillInst D1 (P 0 v I 1 obj I 0 ivSource) @tdQAHHONjJKIK[h\N N LO*9IkذN ]ddN OM NMOOh  hO(157Q \NCONC2 136Q ASSOC 125Q ReadLeafObj 61Q ReadLeafObj) (144Q instance 103Q instance) NIL FireInit D1 (P 1 ls P 0 gfn I 2 expr I 1 varName I 0 self) ZB`OBBIgIgHdH @AlHHgIdI @AlIg(110Q EVAL 54Q EVAL) (127Q ? 74Q AtCreation 40Q Initial 32Q INITIAL 21Q activeValue 13Q activeValue 4 activeValueTYPE#) NIL IVSource D1 (I 0 self) b@ Hd@ @ @j2I KH @ @ JLMh\IJkغM&(76Q ReadLeafObj 63Q \NCONC2 60Q \APPEND2 24Q ReadLeafObj) (40Q instance 31Q instance 3 instance) NIL ModifyInstance D1 (P 6 newEntity P 5 class P 4 nameTable P 3 UID P 2 obj P 1 names P 0 className I 0 classValList) @@rH ]?Hi oi i oi i g _g _OHlOId YI [d Z@d'MK JMJ MK ZIJI @J J(214Q FillInst 204Q NameObject 173Q NewObject 165Q BlankInstance 155Q NewObject 140Q GetObjectRec 133Q MKATOM 123Q REVERSE 76Q FetchMethodOrHelp 66Q GetObjectRec 57Q TERPRI 52Q PRIN1 41Q TERPRI 34Q PRIN1 23Q PRIN1 13Q GetClassRec) (73Q New 63Q Class) (46Q "Defining one now:" 30Q " has no class defined for it") NameObject D1 (I 1 names I 0 object) &A@i H@I`` HX(36Q PUTHASH 10Q GetEntityRec 5 UID) (33Q GlobalNameTable 26Q CurrentNameTable) NIL NewClass D1 (I 1 metaClass I 0 className) :@ohi `d@Ad`g HdIdi@ (67Q NewEntity 44Q GetClassRec 12Q ERROR) (41Q Class 32Q classTYPE# 16Q classTYPE#) (5 "A Class must be given a name at creation. ") NewObject D1 (P 1 obj P 0 newEntity I 1 UID I 0 class F 2 DefaultKBName) @ Ad9 YA -`@ dIdAdRIAAH`` I(74Q PUTHASH 31Q BlankInstance 17Q GetEntityRec 11Q GetObjectRec) (71Q GlobalNameTable 64Q CurrentNameTable 24Q EntityTYPE#) NIL NewWithValues D1 (I 1 description I 0 class) h@A (10Q NewEntity 5 FillIVs) NIL NIL SubstInAV D1 (P 0 ls I 2 av I 1 newLS I 0 oldLS) CB1`BdIBdJHd@A`H@AH dK(72Q SubstInAV) (60Q activeValueTYPE# 34Q activeValue 20Q activeValue 13Q activeValueTYPE# 3 activeValue) NIL TemplateCopy D1 (P 10Q obj% P 5 newpf P 4 newgf P 3 newloc P 2 pf P 1 gf P 0 ls I 2 specSelector I 1 alist I 0 oldValue) 8@ dgN@@@3HAB [IAB \JAB ]HKJMIL@`dKdLdMdg0@dg@AB @AB Nd@O@@NOg@Ng _NglO@A Bf@! O_! Od`h%_BOh _!OO  Bo _OAlOOO__ݰ@Ng _NAlO(452Q FetchMethodOrHelp 403Q ERROR 370Q GetNthMethod 355Q \FindEntryIndex 261Q FASSOC 234Q FetchMethodOrHelp 164Q TemplateCopy 155Q TemplateCopy 63Q TemplateCopy 54Q TemplateCopy 45Q TemplateCopy 3 TYPENAME) (447Q New 343Q class 330Q class 317Q classTYPE# 243Q Template 231Q InstOf! 216Q class 143Q * 132Q LISTP 105Q activeValueTYPE# 32Q activeValue 24Q activeValue 16Q activeValue 7 activeValue) (400Q "not found for DoMethod") UpdateClassIVs D1 (P 6 name I 0 classRec) to@p@ 9d@N@jLMKM]h hKkذk IHhZH&J o@d o@d @ (161Q UpdateIVDescrs 155Q /REPLACEFIELD 152Q ComputeSupersList 134Q /REPLACEFIELD 116Q /REPLACEFIELD 70Q FNTH) (145Q class 127Q class 13Q class) (140Q (class 22Q POINTER) 122Q (class 6 POINTER) 3 (class 10Q POINTER)) UpdateIVDescrs D1 (P 21Q sub P 20Q name P 16Q name P 11Q names P 10Q class P 0 varNames I 0 classRec) 9p@! @ O+o@HAO[O o@H @_d _OOH XO__ HO H O__@O@jJKIK[h hIkذk @O$h_OOh__O_QO&__OOOOjMNLN^h hLkذk O_dO"O" h(460Q UpdateClassIVs 426Q FNTH 255Q FNTH 172Q DREMOVE 145Q \APPEND2 71Q /REPLACEFIELD 57Q /REPLACEFIELD 24Q \APPEND2) (264Q class 123Q class 115Q class 76Q class 17Q class 6 class) (64Q (class 6 POINTER) 37Q (class 10Q POINTER)) (PRETTYCOMPRINT LOOPSSTRUCCOMS) (RPAQQ LOOPSSTRUCCOMS ((* LOOPS --. Written by Daniel G. Bobrow and Mark Stefik 1981-1983 - See the LOOPS Manual) (* Copyright (c) Xerox Corporation 1983) (* * Basic records, operations and macros for dealing with implementation of classes and instances) (RECORDS OBJECT class instance Entity activeValue) (* * Variables and constants used by LOOPS) (CONSTANTS (NotSetValue (QUOTE ?))) ( GLOBALVARS AllObjectNames BrokenVariables CurrentEnvironment CurrentEnvironment CurrentNameTable DefaultComment DefaultEnvironment DefaultLayer DefaultObject FirstEnvFlg GlobalEnvironment GlobalEnvironment GlobalNameTable ImplicitReplaceFns LASTCLASS LastDefaultValue LispClassTable LoadingKernelFlg NETNUMBER NotSetValue OBJECT OpenEnvironments WritingLayerFlg OpenKBFiles) (VARS * LOOPSINITVARS) (* * Access macros) (MACROS * ACCESSMACROS) (* * Interface Functions) (FNS * INTERFACEFNS) (* * Functions which build and change structure) (FNS * STRUCFNS) (ADDVARS (NLAMA DEFINST DEFINSTANCES DEFCLASS DEFCLASSES @ @@ _@ _@@)) (* Copyright (c) 1982 by Xerox Corporation) (* * Templates for masterscope, plus patch given by Larry Masinter to add SEND as a verb to Masterscope) (TEMPLATES * LOOPSSTRUCTEMPLATES) (P (ADDTOVAR TABLE.TO.NOTICED (0 SEND)) (APPENDTOVAR MSFNDATA (SEND ASDF)) (MSSETUP (QUOTE ((SEND SENDS SENDING SENT))))) (ADVISE MSVBTABLES) (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA))))) (BLOCKRECORD OBJECT (CLASS CHANGEDFLG OBJUID VARNAMES VARDESCRS)) (DATATYPE class (metaClass classChangedFlg classUnitRec ivNames ivDescrs localIVs cvNames cvDescrs className supers subClasses otherClassDescription selectors methods otherMethodDescription localSupers )) (DATATYPE instance (class instChangedFlg instUnitRec iNames iDescrs otherIVs)) (DATATYPE Entity (localRecord UID storedIn)) (DATATYPE activeValue (localState getFn putFn)) (/DECLAREDATATYPE (QUOTE class) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER))) (/DECLAREDATATYPE (QUOTE instance) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER))) (/DECLAREDATATYPE (QUOTE Entity) (QUOTE (POINTER POINTER POINTER))) (/DECLAREDATATYPE (QUOTE activeValue) (QUOTE (POINTER POINTER POINTER))) (RPAQQ NotSetValue ?) (CONSTANTS (NotSetValue (QUOTE ?))) (RPAQQ LOOPSINITVARS (BASEFNS DefaultComment LOOPSFREEVARS LeafInstanceFlg WritingSummaryFlg ( TTYIN?=FN (QUOTE GetMethodArgs)) (DEditLinger NIL) (OutInstances NIL) (PPDefault T) (PrintStatusWindow PROMPTWINDOW) (FirstEnvFlg) (WritingLayerFlg) (LASTCLASS) (BrokenVariables) (ErrorOnNameConflict) ( DefaultKBName NIL) (CurrentNameTable NIL) (AllObjectNames NIL) (GlobalNameTable (OR (LISTP (GETTOPVAL (QUOTE GlobalNameTable))) (CONS (HARRAY 128)))) (LispClassTable (OR (LISTP (GETTOPVAL (QUOTE LispClassTable))) (CONS (HARRAY 16)))) (VarNameIndexes NIL) (OpenKBFiles))) (RPAQQ BASEFNS (BlankInstance DumpInstanceFacts FillIVs FillInst GetIVDescr GetIVHere GetValue GetValueOnly IVSource PutValue PutValueOnly)) (RPAQQ DefaultComment NIL) (RPAQQ LOOPSFREEVARS (AFTERLOGOUTFORMS AFTERSYSOUTFORMS AddDeleteMenu AllObjectNames BOLDFONT BrokenVariables Browser COMMENTFONT COMPILE.EXT ClassIVsInspectTitleMenu ClassInspectTitleMenu CurrentEnvironment CurrentNameTable DB.FRONTUI DB.NEXTUIDUMP DB.UICOUNT DB.UIDUMPINCR DB.UIFILENAME DB.UIREC DEFAULTFONT DEFAULTPRINTINGHOST DefaultComment DefaultKBName DefaultObject EDITRDTBL ErrorOnNameConflict FILERDTBL FIRSTCOL FIRSTNAME GlobalEnvironment GlobalNameTable INITIALS INITIALSLST IT ImplicitReplaceFns InspectMenu InspectOrPropsMenu InstanceTitleMenu LAMBDAFONT LASTCLASS LASTWORD LOGINHOST/DIR LOOPSAFTERSYSOUTFORMS LOOPSFILES LastDefaultValue LispClassTable NETNUMBER NotSetValue OBJECT OutInstances PPDefault PROMPTWINDOW PRTTYFILE SYSOUTGAG SYSTEMFILES USERNAME UnnamedInstances VarNameIndexes WritingLayerFlg assocKBNames changedEntities changedKBs classForMethod fileEntities kbName latticeBrowser namedEntities object objectNames oldClassForMethod)) (RPAQQ LeafInstanceFlg T) (RPAQQ WritingSummaryFlg NIL) (RPAQQ TTYIN?=FN GetMethodArgs) (RPAQQ DEditLinger NIL) (RPAQQ OutInstances NIL) (RPAQQ PPDefault T) (RPAQ PrintStatusWindow PROMPTWINDOW) (RPAQQ FirstEnvFlg NIL) (RPAQQ WritingLayerFlg NIL) (RPAQQ LASTCLASS NIL) (RPAQQ BrokenVariables NIL) (RPAQQ ErrorOnNameConflict NIL) (RPAQQ DefaultKBName NIL) (RPAQQ CurrentNameTable NIL) (RPAQQ AllObjectNames NIL) (RPAQ GlobalNameTable (OR (LISTP (GETTOPVAL (QUOTE GlobalNameTable))) (CONS (HARRAY 128)))) (RPAQ LispClassTable (OR (LISTP (GETTOPVAL (QUOTE LispClassTable))) (CONS (HARRAY 16)))) (RPAQQ VarNameIndexes NIL) (RPAQQ OpenKBFiles NIL) (RPAQQ ACCESSMACROS ($ /PutNth @ @@ Class ClassVariables FetchCIVDescr FetchCVDescr FetchIVDescr FetchIVDescr! FindIndex FindVarIndex GetCIVNth GetClassDescr GetNth GetValue GetVarNth InstanceVariables MKNAME Modified Modified? NDescrs NotSetValue ObjGetProp ObjPutProp ObjRealValue ObjRemProp ObjSetValue Object? PutIVDescr PutNth PutValue PutVarNth Supers _@ _@@)) (PUTPROPS $ MACRO (name (LIST (QUOTE GetObjectRec) (KWOTE (CAR name))))) (PUTPROPS /PutNth MACRO ((list index entry) (/RPLACA (FNTH list index) entry))) (PUTPROPS @ MACRO (arg (Parse@ arg (QUOTE IV)))) (PUTPROPS @@ MACRO (arg (Parse@ arg (QUOTE CV)))) (PUTPROPS Class MACRO (OPENLAMBDA (self) (COND ((Object? self) (fetch CLASS of self)) (T (GetLispClass self))))) (PUTPROPS ClassVariables MACRO ((self) (APPEND (fetch (class cvNames) of self)))) (PUTPROPS FetchCIVDescr MACRO ((self varName) (* dgb: "25-JAN-82 15:48") (* * Find the description list for the named variable in a class, returning NIL if none is there.) (PROG NIL (* Short circuit GetNth with embedded RETURN if no index found) (RETURN (GetNth (fetch VARDESCRS of self) (OR ( FindIndex varName (fetch VARNAMES of self)) (RETURN NIL))))))) (PUTPROPS FetchCVDescr MACRO ((classRec varName) (PROG ((index (FindIndex varName (fetch cvNames of classRec)))) (RETURN (COND (index (GetNth (fetch cvDescrs of classRec) index))))))) (PUTPROPS FetchIVDescr MACRO (OPENLAMBDA (self varName) (* dgb: "27-JAN-82 11:07") (* * Find the description list for the named variable, using the varIndex if given, computing it otherwise. If list is NIL in instance, and if createDescrFlg = T then create a local description list in the instance) ( COND ((NOT (type? instance self)) (ERROR self "not instance for FetchIVDescr")) (T (PROG (varIndex descr) (DECLARE (LOCALVARS varIndex descr)) (SETQ varIndex (FindVarIndex varName self)) (RETURN (COND (varIndex (GetVarNth self varIndex)) ((SETQ descr (ASSOC varName (fetch otherIVs of self))) (* * non standard instance variables are stored on an ALIST in otherIVs) (CDR descr)) (T (_ self IVMissing varName NIL))))))))) (PUTPROPS FetchIVDescr! MACRO (OPENLAMBDA (self varName) (PROG (varIndex descr) (* * Find the description list for the named variable. If list is NIL in instance, then create one.) (DECLARE ( LOCALVARS . T)) (SETQ varIndex (FindVarIndex varName self)) (RETURN (COND (varIndex (SETQ descr ( GetVarNth self varIndex)) (COND ((NULL descr) (* Create initial description list with value=NotSetValue) (PutVarNth self varIndex (SETQ descr (LIST NotSetValue))))) descr) ((SETQ descr ( ASSOC varName (fetch otherIVs of self))) (* non standard IVs are stored on an ALIST in otherIVs) (COND ((NULL (CDR descr)) (RPLACD descr (LIST NotSetValue)))) (CDR descr)) (T (_ self IVMissing varName T)) ))))) (PUTPROPS FindIndex MACRO (LAMBDA (entry table) (PROG ((POS 0)) LP (COND ((EQ entry (CAR table)) ( RETURN POS)) ((NULL (SETQ table (CDR table))) (RETURN NIL)) (T (SETQ POS (ADD1 POS)) (GO LP)))))) (PUTPROPS FindVarIndex MACRO (OPENLAMBDA (name obj) (FindIndex name (fetch VARNAMES of obj)))) (PUTPROPS GetCIVNth MACRO (OPENLAMBDA (obj n) (GetNth (fetch VARDESCRS of obj) n))) (PUTPROPS GetClassDescr MACRO (OPENLAMBDA (class) (CONS (fetch metaClass of class) (fetch otherClassDescription of class)))) (PUTPROPS GetNth MACRO (OPENLAMBDA (table index) (CAR (FNTH table (ADD1 index))))) (PUTPROPS GetValue MACRO (arg (ComputeGetValue arg))) (PUTPROPS GetVarNth MACRO (OPENLAMBDA (obj n) (PROG (descrs^) (DECLARE (LOCALVARS . T)) LP (AND (SETQ descrs^ (fetch VARDESCRS of obj)) (RETURN (\GETBASEPTR (\GETBASEPTR descrs^ 0) (LLSH n 1)))) ( ReadLeafObj obj) (GO LP)))) (PUTPROPS InstanceVariables MACRO ((self) (APPEND (fetch VARNAMES of self) (for p in (fetch otherIVs of self) collect (CAR p))))) (PUTPROPS MKNAME MACRO ((X) (* Converts from file form of name to in core form) (MKATOM X))) (PUTPROPS Modified MACRO ((object localState) (* MJS: " 3-SEP-81 15:47") (replace CHANGEDFLG of object with localState))) (PUTPROPS Modified? MACRO (LAMBDA (object) (* MJS: " 3-SEP-81 15:48") (fetch CHANGEDFLG of object))) (PUTPROPS NDescrs MACRO ((n) (ARRAY n (QUOTE POINTER) NIL 0))) (PUTPROPS NotSetValue MACRO ((arg) (EQ NotSetValue arg))) (PUTPROPS ObjGetProp MACRO (OPENLAMBDA (descr propName) (* Called by all fetch fns. Gets value in description list. Does not check for activeValues.) (COND ((LITATOM descr) NotSetValue) ((NULL propName) (CAR descr)) (T (for tail on (CDR descr) by (CDDR tail) do (COND ((EQ propName (CAR tail)) ( RETURN (CADR tail)))) finally (RETURN NotSetValue)))))) (PUTPROPS ObjPutProp MACRO (LAMBDA (descr propName value) (* * Called to put a new value on a decr list by all the Store fns. descr is a non-null list whose first element is a value (not a property) and whose remaining elements form a property list. Adds property if no value there already.) (COND (( NULL propName) (RPLACA descr value) value) (T (for tail on descr bind (pn _ propName) (val _ value) by (CDDR tail) do (COND ((NULL (CDR tail)) (* Add property if not there already.) (RPLACD tail (LIST pn val)) (RETURN val)) ((EQ pn (CADR tail)) (* Replace value if old value found.) (RPLACA (CDDR tail) val ) (RETURN val)))))))) (PUTPROPS ObjRealValue MACRO ((self varName value propName type) (* Called by Fetches and Gets which want to notice activeValues. type is one of NIL for instance variables, CLASS for class properties, METHOD for method properties and CV for class variables and properties. Returns either the value found or the result of evaluating the GETFN) (COND ((type? activeValue value) (PROG ((fn (fetch getFn of value)) (ls (GetLocalState value self varName propName type))) (RETURN (COND (fn (AVApply* fn self varName ls propName value type)) (T ls))))) (T value)))) (PUTPROPS ObjRemProp MACRO (OPENLAMBDA (descr propName) (PROGN (* descr is a non-null list whose first element is a value (not a property) and whose remaining elements form a property list. Removes a property from that list. RETURNS NIL if not found, propname otherwise) (for tail on descr by (CDDR tail) do (COND ((NULL (CDR tail)) (RETURN NIL)) ((EQ propName (CADR tail)) (RPLACD tail (CDDDR tail)) (RETURN propName))))))) (PUTPROPS ObjSetValue MACRO ((self varName newValue descr aValue propName type) (* Called by anyone who wants to set a value of a variable or property of any kind. Does the checking for active values. The argument type is NIL for InstanceVariables, and otherwise is one of CV, CLASS, METHOD) (COND (( type? activeValue aValue) (PROG ((fn (fetch putFn of aValue))) (RETURN (COND (fn (AVApply* fn self varName newValue propName aValue type)) (T (PutLocalState aValue newValue self varName propName type)) )))) (T (Modified self T) (COND (propName (ObjPutProp descr propName newValue)) (T (RPLACA descr newValue))) newValue)))) (PUTPROPS Object? MACRO (OPENLAMBDA (obj) (OR (type? instance obj) (type? class obj)))) (PUTPROPS PutIVDescr MACRO (OPENLAMBDA (obj ivName ivDescr) (PROG (foundIndex localDescr othIVList) LP (COND ((SETQ foundIndex (FindIndex ivName (fetch VARNAMES of obj))) (* * Put the description in the instance) (PutVarNth obj foundIndex ivDescr)) ((NUMBERP (SETQ othIVList (fetch otherIVs of obj))) ( ReadLeafObj obj) (GO LP)) ((SETQ localDescr (ASSOC ivName othIVList)) (* Nonstandard iv, currently here) (RPLACD localDescr ivDescr)) (T (replace otherIVs of obj with (NCONC1 othIVList (CONS ivName ivDescr))))) (RETURN ivDescr)))) (PUTPROPS PutNth MACRO ((list index entry) (RPLACA (FNTH list (ADD1 index)) entry))) (PUTPROPS PutValue MACRO (arg (ComputePutValue arg))) (PUTPROPS PutVarNth MACRO (OPENLAMBDA (obj n desc) (PROG (descrs^) (DECLARE (LOCALVARS . T)) LP (AND ( SETQ descrs^ (fetch VARDESCRS of obj)) (RETURN (SETA descrs^ n desc))) (ReadLeafObj obj) (GO LP)))) (PUTPROPS Supers MACRO ((classRec) (fetch supers of classRec))) (PUTPROPS _@ MACRO (arg (ParsePut@ arg (QUOTE IV)))) (PUTPROPS _@@ MACRO (arg (ParsePut@ arg (QUOTE CV)))) (RPAQQ INTERFACEFNS (ComputeGetValue ComputePutValue DumpClassFacts DumpInstanceFacts DumpPruneDescr DumpPruneDescr1 EntityModified FastClassInitialize FillIVs FillInClass FillInClass1 GetEntityRec GetIVDescr GetIVHere GetInitialValue GetObjFromUID GetObjectName1 GetValue GetValueOnly GetClassRec GetObjectName GetObjectRec NameEntity NewEntity PutValue PutValueOnly UnNameEntity)) (RPAQQ STRUCFNS (BlankInstance DefineMethod FillInst FireInit IVSource ModifyInstance NameObject NewClass NewObject NewWithValues SubstInAV TemplateCopy UpdateClassIVs UpdateIVDescrs)) (ADDTOVAR NLAMA DEFINST DEFINSTANCES DEFCLASS DEFCLASSES @ @@ _@ _@@) (RPAQQ LOOPSSTRUCTEMPLATES (@ @@ _ _New _Super (QUOTE _) (QUOTE _New) (QUOTE _Super))) (SETTEMPLATE (QUOTE @) (QUOTE (EVAL .. EVAL))) (SETTEMPLATE (QUOTE @@) (QUOTE (CALL .. EVAL))) (SETTEMPLATE (QUOTE _) (QUOTE (EVAL SEND .. EVAL))) (SETTEMPLATE (QUOTE _New) (QUOTE (EVAL SEND .. EVAL))) (SETTEMPLATE (QUOTE _Super) (QUOTE (EVAL SEND .. EVAL))) (SETTEMPLATE (QUOTE (QUOTE _)) NIL) (SETTEMPLATE (QUOTE (QUOTE _New)) NIL) (SETTEMPLATE (QUOTE (QUOTE _Super)) NIL) (ADDTOVAR TABLE.TO.NOTICED (0 SEND)) (APPENDTOVAR MSFNDATA (SEND ASDF)) (MSSETUP (QUOTE ((SEND SENDS SENDING SENT)))) (PUTPROPS MSVBTABLES READVICE (NIL (BEFORE NIL (COND ((EQ VERB (QUOTE SEND)) (RETURN (QUOTE (0)))))))) (READVISE MSVBTABLES) NIL